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).

diff --git a/perlmail-accept b/perlmail-accept
index 75dfa4a..d9a944d 100755 (executable)
--- 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