From f29d6dc23ac3e500c8afad40a165f3d45fb67998 Mon Sep 17 00:00:00 2001
From: short <>
Date: Sat, 19 Feb 2005 16:35:29 +0000
Subject: [PATCH] Discard local(*STDOUT,*STDERR) as it does not work and it
 causes mysteries. &dnsbl: Do not accept "Invalid IP address" as spam incator.
  - kernel.org mailing lists contain it in its "Received" headers. +&clamscan:
 Use clamscan(1).

---
 perlmail-accept | 99 +++++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 76 insertions(+), 23 deletions(-)

diff --git a/perlmail-accept b/perlmail-accept
index 75dfa4a..d9a944d 100755
--- a/perlmail-accept
+++ b/perlmail-accept
@@ -71,6 +71,8 @@ use URI::Escape 'uri_escape';
 require WWW::SMS;
 require Authen::SASL;	# Sanity check for &Net::SMTP::auth
 use MIME::Base64;
+use IPC::Open3;
+use POSIX ":sys_wait_h";
 
 
 our($Message,@AuditStored,$DoBell);
@@ -133,8 +135,10 @@ sub inetd
 		$length==($_=read STDIN,$message,$length) or confess "Got $_ out of required $length bytes";
 		$length==length $message or confess "False read return ".length($message)." instead of $length";
 		{
-			local *STDOUT;	# FIXME: fd's inherited by spawned processes are not closed this way!
-			local *STDERR;	# FIXME: fd's inherited by spawned processes are not closed this way!
+			# Do not: local *STDOUT;	# FIXME: fd's inherited by spawned processes are not closed this way!
+			#         local *STDERR;	# FIXME: fd's inherited by spawned processes are not closed this way!
+			# as IPC::Open3 and IPC::Open2 will not redirect the output
+			# and send it to the original socket instead!
 			local $DoBell=0;
 			process $message;
 			if ($DoBell) {
@@ -489,6 +493,18 @@ my($message)=@_;
 
 # utility functions:
 
+sub _spamchildcode
+{
+my($err,$isspam)=@_;
+
+	$err=$? if !defined $err;
+	return undef() if !WIFEXITED($?);
+	return undef() if  WIFSIGNALED($?);
+	return undef() if  WIFSTOPPED($?);
+	return $isspam||1 if  WEXITSTATUS($?);	# is-spam
+	return 0;	# not-spam
+}
+
 # return: true (error-message or "1") if is spam
 sub spamassassin
 {
@@ -504,16 +520,12 @@ my($cmd)=@_;
 	open CHILD,"|$cmd --mbox >/dev/null 2>/dev/null"
 			or return 0;
 	print CHILD $Message;
-	my $return=close CHILD;
-	return undef() if !WIFEXITED($?);
-	return undef() if  WIFSIGNALED($?);
-	return undef() if  WIFSTOPPED($?);
-	return 1       if  WEXITSTATUS($?);	# is-spam
-	return 0;	# not-spam
+	close CHILD;
+	return _spamchildcode;
 }
 
 # NOTE: returns undef() if !wantarray and the first header is unrecognized
-# Returns also hosts
+# Returns always HOST:IP pair(s).
 sub Received_for
 {
 	my @r=();
@@ -530,27 +542,68 @@ sub Received_for
 
 # Extended Mail::Audit::MAPS
 # $domain,$full,[$timeout]
+# Returns false if valid, code if spam detected.
 sub dnsbl
 {
 my($domain,$full,$timeout)=@_;
 
 	$timeout||=30;	# sec
 	$Mail::Audit::MAPS::host=$domain;
-	my @hosts=map({ s/^.*://; "[$_]"; }	# strip DNS part
-			grep({ /^([^:@]*):/	# $1 is DNS name, $' is IP address
-					&& !$alternates_host{$1}	# leave only foreign hosts
-					&& !$dnsbl_whitelist{$'}; } (Received_for()))
-			);
-	splice @hosts,1 if !$full && @hosts;	# "&& @hosts" to prevent: WARN: splice() offset past end of array
-	{
-		package My::Audit::Faked;
-		sub received { return @{$_[0]->{"received"}}; }
+	for my $host (Received_for()) {
+		next if $host!~/^([^:@]*):/;
+		my $ip=$';
+		# $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);
+		next if !$code;
+		# Some 0.0.0.0 etc. found for <linux-kernel@>, see: &Mail::Audit::MAPS::_checkit
+		return $code if $code!='1 Invalid IP address ';
+		return if !$full;
 		}
-	my $self_faked={
-			"received"=>[@hosts],
-			};
-	bless $self_faked,"My::Audit::Faked";
-	return Mail::Audit::rblcheck($self_faked,$timeout);
+}
+
+# Returns true if IS virus; the message will contain the virus name
+sub clamscan
+{
+my($cmd)=@_;
+
+	$cmd||='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);
+	local $SIG{"PIPE"}=sub { warn "clamscan '$cmd' gave me SIGPIPE: broken pipe"; };
+	my $pid=open3(\*WR,\*RD,\*ERR,$cmd.' 2>&1')
+			or do { cluck "IPC::Open3 $cmd: $!"; return 0; };
+	print WR $Message;
+	close WR or do { cluck "close WR of $cmd: $!"; return 0; };
+	my $status=do { local $/=undef(); <RD>; };
+	close RD or do { cluck "close RD of $cmd: $!"; return 0; };
+	# Do not: $status.=do { local $/=undef(); <ERR>; };
+	#         close ERR or do { cluck "close ERR of $cmd: $!"; return 0; };
+	# (FIXME) as it causes: Use of uninitialized value in <HANDLE>
+	# waitpid fills $? for: &_spamchildcode
+	local $SIG{"ALRM"}=sub { warn "Timeout $clamscan_waitpid_timeout sec waiting for child $cmd"; };
+	alarm $clamscan_waitpid_timeout;
+	# Do not: WNOHANG
+	# as it would not be enough for clamscan(1) even after all close-s above.
+	my $pidcheck=waitpid($pid,0);
+	alarm 0;
+	my $err=$?;
+	$pidcheck && $pidcheck==$pid
+			or do { cluck "waitpid for $cmd returned $pidcheck!=$pid"; return 0; };
+	$status=~s/^stdin: //;
+	$status=~s/\n$//;
+	return $status if $status ne "OK" && $status;
+	return _spamchildcode $err,$status;
 }
 
 sub muttrc_aliases
-- 
1.8.3.1