+@alternates_host to catch redirected mail w/o "for" header

BlackList spam: +&dnsbl as wrapper around &Mail::Audit::rblcheck
&cut: max length: 64 -> 128
+Mail::Audit logging to $HOME/.lacemail.log
Fixed --smstest
&Received_for: +returns also "hostname:IPaddr" in order: ['for'],['from']
&muttrc_aliases: use always the last occurence to prefer nicks

diff --git a/perlmail-accept b/perlmail-accept
index 1954c99..9ba5cf5 100755 (executable)
--- a/perlmail-accept
+++ b/perlmail-accept
@@ -59,7 +59,8 @@ my $SMSmailRcpt=$SMSwebRcpt.'@sms.eurotel.cz';
 my $SMScontact='<short@ucw.cz>';
 
 our($Message,$Audit,@AuditStored,$store_ignore,$store_ignorenewmail,$store_profile,$DoBell);
 my $SMScontact='<short@ucw.cz>';
 
 our($Message,$Audit,@AuditStored,$store_ignore,$store_ignorenewmail,$store_profile,$DoBell);

-our(%audit_profile,@sms_squeezes);     # imported
+our(%audit_profile,@sms_squeezes,@alternates_host);    # imported
+my %alternates_host;   # from @alternates_host

 
 # from RedHat "procmail-3.22-5"
 # /i should be only $procmailFROM_DAEMON but how it can hurt to /i all?
 
 # from RedHat "procmail-3.22-5"
 # /i should be only $procmailFROM_DAEMON but how it can hurt to /i all?


@@ -479,8 +480,8 @@ sub cut
        return "<???>" if !defined($_) || /^\s*$/s;
        s/^\s*//s;
        s/\s*$//s;
        return "<???>" if !defined($_) || /^\s*$/s;
        s/^\s*//s;
        s/\s*$//s;

-       return $_ if length($_)<64;
-       return substr($_,0,64)."...";
+       return $_ if length($_)<128;
+       return substr($_,0,128)."...";

 }
 
 our $profile_eval_depth=0;
 }
 
 our $profile_eval_depth=0;


@@ -585,9 +586,11 @@ my($message)=@_;
        local $Audit=Mail::Audit->new(
                        "emergency"=>"$Mail/emergency",
                        "data"=>[map("$_\n",split("\n",$message))],
        local $Audit=Mail::Audit->new(
                        "emergency"=>"$Mail/emergency",
                        "data"=>[map("$_\n",split("\n",$message))],

+                       "log"=>"$HOME/.lacemail.log",
+                       "loglevel"=>99,

                        );
        local @AuditStored=();
                        );
        local @AuditStored=();

-       do { smssend $opt_smstest; return; } if $opt_smstest;
+       do { smssend 0,$opt_smstest; return; } if $opt_smstest;

        write_message("$Mail/input");
        audit();
        warn 'Corrupted $_, repaired' if defined($save_)!=defined($_) || (defined($_) && $save_ ne $_);
        write_message("$Mail/input");
        audit();
        warn 'Corrupted $_, repaired' if defined($save_)!=defined($_) || (defined($_) && $save_ ne $_);


@@ -625,6 +628,7 @@ sub razor2
 }
 
 # NOTE: returns undef() if !wantarray and the first header is unrecognized
 }
 
 # NOTE: returns undef() if !wantarray and the first header is unrecognized

+# Returns also hosts

 sub Received_for
 {
        my @r=();
 sub Received_for
 {
        my @r=();


@@ -632,10 +636,35 @@ sub Received_for
                my($for)=($hdr=~/\bfor\s+\<?(\S+)\>?\b/);
                return $for if !wantarray();
                push @r,$for if $for;
                my($for)=($hdr=~/\bfor\s+\<?(\S+)\>?\b/);
                return $for if !wantarray();
                push @r,$for if $for;

+               my($from,$fromaddr)=($hdr=~/\bfrom\s+(\S+)\b.*?\[((?:\d{1,3}\.){3}\d{1,3})\]/);
+               push @r,"$from:$fromaddr" if $from;

                }
        return @r;
 }
 
                }
        return @r;
 }
 

+# Extended Mail::Audit::MAPS
+# $domain,$full,[$timeout]
+sub dnsbl
+{
+my($domain,$full,$timeout)=@_;
+
+       $timeout||=30;  # sec
+       $Mail::Audit::MAPS::host=$domain;
+       my @hosts=map({ s/^.*://; "[$_]"; }     # strip DNS part
+                       grep({ /^([^:@]*):/ && !$alternates_host{$1}; } (Received_for()))       # leave only foreign hosts
+                       );
+       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"}}; }
+               }
+       my $self_faked={
+                       "received"=>[@hosts],
+                       };
+       bless $self_faked,"My::Audit::Faked";
+       return Mail::Audit::rblcheck($self_faked,$timeout);
+}
+

 our %muttrc_pending=();
 sub muttrc
 {
 our %muttrc_pending=();
 sub muttrc
 {


@@ -713,12 +742,26 @@ sub muttrc_aliases
                for my $addrobj (Mail::Address->parse($')) {
                        my $addr=$addrobj->address();
                        my $ref=\$r{"\L$addr"};
                for my $addrobj (Mail::Address->parse($')) {
                        my $addr=$addrobj->address();
                        my $ref=\$r{"\L$addr"};

-                       $$ref=$key if !$$ref;
+                       $$ref=$key;     # use always the last occurence to prefer nicks

                        }
                }
        return %r;
 }
 
                        }
                }
        return %r;
 }
 

+# FIXME: Unify
+# BEGIN lacemail-sendmail
+# return: Mail::Address instance or undef()
+sub parseone
+{
+my($line)=@_;
+
+       return undef() if !defined $line;
+       my @r=Mail::Address->parse($line);
+       warn "Got ".scalar(@r)." addresses while wanting just one; when parsing: $line" if 1!=@r;
+       return $r[0];
+}
+# END lacemail-sendmail
+

 # FIXME: host may get multiple recipients and thus not showing "for <...>"
 # FIXME: muttrc_get("from") is too strict
 sub store_muttrc_alternates
 # FIXME: host may get multiple recipients and thus not showing "for <...>"
 # FIXME: muttrc_get("from") is too strict
 sub store_muttrc_alternates


@@ -729,11 +772,22 @@ my($prefix,$profile)=@_;
        my $alternatesre=qr/$alternates/si;
        my $From=muttrc_get("from") or return;
        my $Fromre=qr/^\Q$From\E$/si;
        my $alternatesre=qr/$alternates/si;
        my $From=muttrc_get("from") or return;
        my $Fromre=qr/^\Q$From\E$/si;

-       warn "'From' \"$From\" not matches by 'alternates': $alternatesre"
+       my $Fromobj=parseone $From or return;
+       warn "'From' \"$From\" not matched by 'alternates': $alternatesre"

                        if $From!~/$alternates/si;
        for my $for (reverse Received_for()) {
                        if $From!~/$alternates/si;
        for my $for (reverse Received_for()) {

-               return if $for=~/$From/si;
-               next if $for!~/$alternatesre/si;
+               $for=~s/:.*$//; # strip IP address here
+               if ($Fromobj->user() ne "prog-mutt") {
+                       next if lc($for) eq lc($From);
+                       }
+               else {
+                       my $forobj=parseone $for;
+                       if ($forobj && $forobj->host()) {
+                               # it is 'for' our primary address
+                               next if lc($forobj->host()) eq lc($Fromobj->host());    # or 'return'? shouldn't matter
+                               }
+                       }
+               next if !$alternates_host{lc $for} && $for!~/$alternatesre/si;

                store "$prefix\L$for",($profile || []);
                return;
                }
                store "$prefix\L$for",($profile || []);
                return;
                }


@@ -827,6 +881,7 @@ open AUDIT,$filenameMyAudit or die "open \"$filenameMyAudit\": $!";
        local $/=undef();
        eval <AUDIT> or die "eval \"$filenameMyAudit\": $@";
        audit_init();
        local $/=undef();
        eval <AUDIT> or die "eval \"$filenameMyAudit\": $@";
        audit_init();

+       %alternates_host=map((lc($_)=>1),@alternates_host);

        }
 close AUDIT or warn "close \"$filenameMyAudit\": $!";
 
        }
 close AUDIT or warn "close \"$filenameMyAudit\": $!";