host0 state

[PerlMail.git] / perlmail-accept

diff --git a/perlmail-accept b/perlmail-accept
index f058618..20b5b20 100755 (executable)
--- 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; },