You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@spamassassin.apache.org by he...@apache.org on 2018/11/05 10:51:53 UTC

svn commit: r1845773 - in /spamassassin/trunk: ./ lib/Mail/SpamAssassin/ lib/Mail/SpamAssassin/Plugin/

Author: hege
Date: Mon Nov  5 10:51:52 2018
New Revision: 1845773

URL: http://svn.apache.org/viewvc?rev=1845773&view=rev
Log:
- Better document bgsend_and_start_lookup, the only offical async call we should use. $ent->{rulename} is the only value required, everything else is automatic.
- Deprecate direct calls to start_lookup.
- Deprecate unused get_lookup function.
- Related and other URIDNSBL code cleanups.
- Make sure idn_to_ascii is called in bgsend_and_start_lookup.
- Misc DNS and logging cleanups.

Modified:
    spamassassin/trunk/UPGRADE
    spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URILocalBL.pm

Modified: spamassassin/trunk/UPGRADE
URL: http://svn.apache.org/viewvc/spamassassin/trunk/UPGRADE?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/UPGRADE (original)
+++ spamassassin/trunk/UPGRADE Mon Nov  5 10:51:52 2018
@@ -63,7 +63,7 @@ Note for Users Upgrading to SpamAssassin
   bgsend_and_start_lookup which handles required things automatically
   (direct calls to bgsend or start_lookup should not be used),
   bgsend_and_start_lookup should always contain $ent->{rulename} for correct
-  meta dependency handling.
+  meta dependency handling. Deprecated also start_lookup, get_lookup.
 
 - SPF: Mail::SPF is now only supported.  Mail::SPF::Query use is deprecated,
   along with settings do_not_use_mail_spf, do_not_use_mail_spf_query.  SPF

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm Mon Nov  5 10:51:52 2018
@@ -42,6 +42,7 @@ use Time::HiRes qw(time);
 
 use Mail::SpamAssassin;
 use Mail::SpamAssassin::Logger;
+use Mail::SpamAssassin::Util qw(idn_to_ascii);
 
 our @ISA = qw();
 
@@ -109,40 +110,52 @@ sub domain_to_search_list {
 
 # ---------------------------------------------------------------------------
 
-=item $ent = $async->start_lookup($ent, $master_deadline)
+=item $ent = $async->bgsend_and_start_lookup($name, $type, $class, $ent, $cb, %options)
 
-DIRECT USE DISCOURAGED, please use bgsend_and_start_lookup in plugins.
+Launch async DNS lookups.  This is the only official method supported for
+plugins since version 4.0.0.  Do not use bgsend and start_lookup separately.
 
-Register the start of a long-running asynchronous lookup operation.
-C<$ent> is a hash reference containing the following items:
+Merges duplicate queries automatically, only launches one and calls all
+related callbacks on answer.
 
 =over 4
 
-=item key (required)
+=item $name (required)
+
+Name to query.
+
+=item $type (required)
 
-A key string, unique to this lookup.  This is what is reported in
-debug messages, used as the key for C<get_lookup()>, etc.
+Type to query, A, TXT, NS, etc.
 
-=item id (required)
+=item $class (required/deprecated)
 
-An ID string, also unique to this lookup.  Typically, this is the DNS packet ID
-as returned by DnsResolver's C<bgsend> method.  Sadly, the Net::DNS
-architecture forces us to keep a separate ID string for this task instead of
-reusing C<key> -- if you are not using DNS lookups through DnsResolver, it
-should be OK to just reuse C<key>.
+Deprecated, ignored, set as undef.
+
+=item C<$ent> is a required hash reference containing the following items:
+
+=over 4
 
-=item type (required)
+=item $ent->{rulename} (required)
+
+The rulename that started and/or depends on this query.  Required for rule
+dependencies to work correctly.  Can be a single rulename, or array of
+multiple rulenames.
+
+=item $ent->{type} (optional)
 
 A string, typically one word, used to describe the type of lookup in log
-messages, such as C<DNSBL>, C<MX>, C<TXT>.
+messages, such as C<DNSBL>, C<URIBL-A>.  If not defined, default is value of
+$type.
 
-=item zone (optional)
+=item $ent->{zone} (optional)
 
-A zone specification (typically a DNS zone name - e.g. host, domain, or RBL)
-which may be used as a key to look up per-zone settings. No semantics on this
-parameter is imposed by this module. Currently used to fetch by-zone timeouts.
+A zone specification (typically a DNS zone name - e.g.  host, domain, or
+RBL) which may be used as a key to look up per-zone settings.  No semantics
+on this parameter is imposed by this module.  Currently used to fetch
+by-zone timeouts (from rbl_timeout setting).  Defaults to $name.
 
-=item timeout_initial (optional)
+=item $ent->{timeout_initial} (optional)
 
 An initial value of elapsed time for which we are willing to wait for a
 response (time in seconds, floating point value is allowed). When elapsed
@@ -159,102 +172,37 @@ variable rbl_timeout.
 If a value of the timeout_initial parameter is below timeout_min, the initial
 timeout is set to timeout_min.
 
-=item timeout_min (optional)
+=item $ent->{timeout_min} (optional)
 
 A lower bound (in seconds) to which the actual timeout approaches as the
 number of queries completed approaches the number of all queries started.
 Defaults to 0.2 * timeout_initial.
 
-=back
-
-C<$ent> is returned by this method, with its contents augmented by additional
-information.
-
-=cut
-
-sub start_lookup {
-  my ($self, $ent, $master_deadline) = @_;
-
-  my $id  = $ent->{id};
-  my $key = $ent->{key};
-  defined $id && $id ne ''  or die "oops, no id";
-  $key                      or die "oops, no key";
-  $ent->{type}              or die "oops, no type";
-
-  my $now = time;
-  $ent->{start_time} = $now  if !defined $ent->{start_time};
-
-  # are there any applicable per-zone settings?
-  my $zone = $ent->{zone};
-  my $settings;  # a ref to a by-zone or to global settings
-  my $conf_by_zone = $self->{main}->{conf}->{by_zone};
-  if (defined $zone && $conf_by_zone) {
-  # dbg("async: searching for by_zone settings for $zone");
-    $zone =~ s/^\.//;  $zone =~ s/\.\z//;  # strip leading and trailing dot
-    for (;;) {  # 2.10.example.com, 10.example.com, example.com, com, ''
-      if (exists $conf_by_zone->{$zone}) {
-        $settings = $conf_by_zone->{$zone};
-        last;
-      } elsif ($zone eq '') {
-        last;
-      } else {  # strip one level, careful with address literals
-        $zone = ($zone =~ /^( (?: [^.] | \[ (?: \\. | [^\]\\] )* \] )* )
-                            \. (.*) \z/xs) ? $2 : '';
-      }
-    }
-  }
-
-  dbg("async: applying by_zone settings for %s", $zone)  if $settings;
+=item $ent->{key}, $ent->{id} (deprecated)
 
-  my $t_init = $ent->{timeout_initial};  # application-specified has precedence
-  $t_init = $settings->{rbl_timeout}  if $settings && !defined $t_init;
-  $t_init = $self->{main}->{conf}->{rbl_timeout}  if !defined $t_init;
-  $t_init = 0  if !defined $t_init;      # last-resort default, just in case
-
-  my $t_end = $ent->{timeout_min};       # application-specified has precedence
-  $t_end = $settings->{rbl_timeout_min}  if $settings && !defined $t_end;
-  $t_end = $self->{main}->{conf}->{rbl_timeout_min}  if !defined $t_end; # added for bug 7070
-  $t_end = 0.2 * $t_init  if !defined $t_end;
-  $t_end = 0  if $t_end < 0;  # just in case
-  $t_init = $t_end  if $t_init < $t_end;
+Deprecated, ignored, automatically generated since 4.0.0.
 
-  my $clipped_by_master_deadline = 0;
-  if (defined $master_deadline) {
-    my $time_avail = $master_deadline - time;
-    $time_avail = 0.5  if $time_avail < 0.5;  # give some slack
-    if ($t_init > $time_avail) {
-      $t_init = $time_avail; $clipped_by_master_deadline = 1;
-      $t_end  = $time_avail  if $t_end > $time_avail;
-    }
-  }
-  $ent->{timeout_initial} = $t_init;
-  $ent->{timeout_min} = $t_end;
+=item $ent->{YOUR_OWN_ITEM}
 
-  $ent->{display_id} =  # identifies entry in debug logging and similar
-    join(", ", grep { defined }
-               map { ref $ent->{$_} ? @{$ent->{$_}} : $ent->{$_} }
-               qw(sets rules rulename type key) );
+Any other custom values/objects that you want to pass on to the answer
+callback.
 
-  $self->{pending_lookups}->{$key} = $ent;
+=back
 
-  $self->{queries_started}++;
-  dbg("async: starting: %s (timeout %.1fs, min %.1fs)%s",
-      $ent->{display_id}, $ent->{timeout_initial}, $ent->{timeout_min},
-      !$clipped_by_master_deadline ? '' : ', capped by time limit');
+=item $cb (required)
 
-  $ent;
-}
+Callback function for answer, called as $cb->($ent, $pkt).  C<$ent> is the
+same object that bgsend_and_start_lookup was called with.  C<$pkt> is the
+packet object for the response, Net::DNS:RR objects can be found from
+$pkt->answer.
 
-# ---------------------------------------------------------------------------
+=item %options (required)
 
-=item $ent = $async->bgsend_and_start_lookup($domain, $type, $class, $ent, $cb, %options)
+Hash of options. Only supported and required option is master_deadline:
 
-A common idiom: calls C<bgsend>, followed by a call to C<start_lookup>,
-returning the argument $ent object as modified by C<start_lookup> and
-filled-in with a query ID.
+  master_deadline => $pms->{master_deadline}
 
-$ent->{rulename} should always be defined, so meta dependencies pending
-checks work correctly.
+=back
 
 =cut
 
@@ -276,7 +224,7 @@ sub bgsend_and_start_lookup {
   # Waiting for priority -100 to launch?
   if ($self->{wait_launch}) {
     push @{$self->{bgsend_queue}}, [@_];
-    dbg("async: dns priority not reached, queueing lookup: $_[0] $_[1]");
+    dbg("async: dns priority not reached, queueing lookup: $domain/$type");
     return $ent;
   }
 
@@ -284,6 +232,9 @@ sub bgsend_and_start_lookup {
     info("async: bgsend_and_start_lookup called without rulename: $domain/$type");
   }
 
+  $domain =~ s/\.+\z//s;  # strip trailing dots, these sometimes still sneak in
+  $domain = idn_to_ascii($domain);
+
   # At this point the $domain should already be encoded to UTF-8 and
   # IDN converted to ASCII-compatible encoding (ACE).  Make sure this is
   # really the case in order to be able to catch any leftover omissions.
@@ -298,20 +249,21 @@ sub bgsend_and_start_lookup {
          "called from %s line %d", $domain, $package, $line);
   }
 
+  my $dnskey = uc($type).'/'.lc($domain);
+  my $dns_query_info = $self->{all_lookups}{$dnskey};
+
   $ent = {}  if !$ent;
-  $domain =~ s/\.+\z//s;  # strip trailing dots, these sometimes still sneak in
   $ent->{id} = undef;
+  $ent->{key} = $dnskey  if !exists $ent->{key};
   $ent->{query_type} = $type;
   $ent->{query_domain} = $domain;
   $ent->{type} = $type  if !exists $ent->{type};
+  $ent->{zone} = $domain  if !exists $ent->{zone};
   $cb = $ent->{completed_callback}  if !$cb;  # compatibility with SA < 3.4
 
-  my $key = $ent->{key} || '';
+  my $key = $ent->{key};
   my $rulename = $ent->{rulename};
 
-  my $dnskey = uc($type) . '/' . lc($domain);
-  my $dns_query_info = $self->{all_lookups}{$dnskey};
-
   if ($dns_query_info) {  # DNS query already underway or completed
     my $id = $ent->{id} = $dns_query_info->{id};  # re-use existing query
     return if !defined $id;  # presumably blocked, or other fatal failure
@@ -445,26 +397,112 @@ sub bgsend_and_start_lookup {
     } else {
       $self->{pending_rules}->{$rulename}{$key} = 1 if $rulename;
     }
-    $self->start_lookup($ent, $options{master_deadline});
+    $self->_start_lookup($ent, $options{master_deadline});
   }
   return $ent;
 }
 
 # ---------------------------------------------------------------------------
 
-=item $ent = $async->get_lookup($key)
+=item $ent = $async->start_lookup($ent, $master_deadline)
+
+DIRECT USE DEPRECATED since 4.0.0, please use bgsend_and_start_lookup.
+
+=cut
+
+sub start_lookup {
+  my $self = shift;
+  warn "deprecated start_lookup called, please use bgsend_and_start_lookup"
+    if !$self->{start_lookup_warned};
+  $self->{start_lookup_warned} = 1;
+  $self->_start_lookup(@_);
+}
 
-Retrieve the pending-lookup object for the given key C<$key>.
+# Internal use not deprecated. :-)
+sub _start_lookup {
+  my ($self, $ent, $master_deadline) = @_;
 
-If the lookup is complete, this will return C<undef>.
+  my $id  = $ent->{id};
+  my $key = $ent->{key};
+  defined $id && $id ne ''  or die "oops, no id";
+  $key                      or die "oops, no key";
+  $ent->{type}              or die "oops, no type";
+
+  my $now = time;
+  $ent->{start_time} = $now  if !defined $ent->{start_time};
+
+  # are there any applicable per-zone settings?
+  my $zone = $ent->{zone};
+  my $settings;  # a ref to a by-zone or to global settings
+  my $conf_by_zone = $self->{main}->{conf}->{by_zone};
+  if (defined $zone && $conf_by_zone) {
+  # dbg("async: searching for by_zone settings for $zone");
+    $zone =~ s/^\.//;  $zone =~ s/\.\z//;  # strip leading and trailing dot
+    for (;;) {  # 2.10.example.com, 10.example.com, example.com, com, ''
+      if (exists $conf_by_zone->{$zone}) {
+        $settings = $conf_by_zone->{$zone};
+        last;
+      } elsif ($zone eq '') {
+        last;
+      } else {  # strip one level, careful with address literals
+        $zone = ($zone =~ /^( (?: [^.] | \[ (?: \\. | [^\]\\] )* \] )* )
+                            \. (.*) \z/xs) ? $2 : '';
+      }
+    }
+  }
 
-Note that a lookup is still considered "pending" until C<complete_lookups()> is
-called, even if it has been reported as complete via C<set_response_packet()>.
+  dbg("async: applying by_zone settings for %s", $zone)  if $settings;
+
+  my $t_init = $ent->{timeout_initial};  # application-specified has precedence
+  $t_init = $settings->{rbl_timeout}  if $settings && !defined $t_init;
+  $t_init = $self->{main}->{conf}->{rbl_timeout}  if !defined $t_init;
+  $t_init = 0  if !defined $t_init;      # last-resort default, just in case
+
+  my $t_end = $ent->{timeout_min};       # application-specified has precedence
+  $t_end = $settings->{rbl_timeout_min}  if $settings && !defined $t_end;
+  $t_end = $self->{main}->{conf}->{rbl_timeout_min}  if !defined $t_end; # added for bug 7070
+  $t_end = 0.2 * $t_init  if !defined $t_end;
+  $t_end = 0  if $t_end < 0;  # just in case
+  $t_init = $t_end  if $t_init < $t_end;
+
+  my $clipped_by_master_deadline = 0;
+  if (defined $master_deadline) {
+    my $time_avail = $master_deadline - time;
+    $time_avail = 0.5  if $time_avail < 0.5;  # give some slack
+    if ($t_init > $time_avail) {
+      $t_init = $time_avail; $clipped_by_master_deadline = 1;
+      $t_end  = $time_avail  if $t_end > $time_avail;
+    }
+  }
+  $ent->{timeout_initial} = $t_init;
+  $ent->{timeout_min} = $t_end;
+
+  $ent->{display_id} =  # identifies entry in debug logging and similar
+    join(", ", grep { defined }
+               map { ref $ent->{$_} ? @{$ent->{$_}} : $ent->{$_} }
+               qw(sets rules rulename type key) );
+
+  $self->{pending_lookups}->{$key} = $ent;
+
+  $self->{queries_started}++;
+  dbg("async: starting: %s (timeout %.1fs, min %.1fs)%s",
+      $ent->{display_id}, $ent->{timeout_initial}, $ent->{timeout_min},
+      !$clipped_by_master_deadline ? '' : ', capped by time limit');
+
+  $ent;
+}
+
+# ---------------------------------------------------------------------------
+
+=item $ent = $async->get_lookup($key)
+
+DEPRECATED since 4.0.0. Do not use.
 
 =cut
 
 sub get_lookup {
   my ($self, $key) = @_;
+  warn("deprecated get_lookup function used");
   return $self->{pending_lookups}->{$key};
 }
 
@@ -563,7 +601,7 @@ sub complete_lookups {
         $ent->{finish_time} = $now  if !defined $ent->{finish_time};
         my $elapsed = $ent->{finish_time} - $ent->{start_time};
         dbg("async: completed in %.3f s: %s", $elapsed, $ent->{display_id});
-        $self->{timing_by_query}->{". $key"} += $elapsed;
+        $self->{timing_by_query}->{". $key ($ent->{type})"} += $elapsed;
         $self->{queries_completed}++;
         delete $pending->{$key};
       }
@@ -680,6 +718,8 @@ sub abort_remaining_lookups {
 
 =item $async->set_response_packet($id, $pkt, $key, $timestamp)
 
+For internal use, do not call from plugins.
+
 Register a "response packet" for a given query.  C<$id> is the ID for the
 query, and must match the C<id> supplied in C<start_lookup()>. C<$pkt> is the
 packet object for the response. A parameter C<$key> identifies an entry in a
@@ -731,6 +771,8 @@ sub set_response_packet {
 
 =item $async->report_id_complete($id,$key,$key,$timestamp)
 
+DEPRECATED since 4.0.0. Do not use.
+
 Legacy. Equivalent to $self->set_response_packet($id,undef,$key,$timestamp),
 i.e. providing undef as a response packet. Register that a query has
 completed and is no longer "pending". C<$id> is the ID for the query,

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm Mon Nov  5 10:51:52 2018
@@ -29,7 +29,7 @@ use Mail::SpamAssassin::Conf;
 use Mail::SpamAssassin::PerMsgStatus;
 use Mail::SpamAssassin::AsyncLoop;
 use Mail::SpamAssassin::Constants qw(:ip);
-use Mail::SpamAssassin::Util qw(untaint_var am_running_on_windows idn_to_ascii);
+use Mail::SpamAssassin::Util qw(untaint_var am_running_on_windows);
 
 use File::Spec;
 use IO::Socket;
@@ -101,42 +101,30 @@ BEGIN {
 sub do_rbl_lookup {
   my ($self, $rule, $set, $type, $host, $subtest) = @_;
 
-  $host = idn_to_ascii($host);
-  my $key = "dns:$type:$host";
-
   my $ent = {
-    key => $key,
-    zone => $host,  # serves to fetch other per-zone settings
-    type => "DNSBL-".$type,
+    rulename => $rule,
+    type => "DNSBL",
     set => $set,
     subtest => $subtest,
-    rulename => $rule,
   };
-  $ent = $self->{async}->bgsend_and_start_lookup(
-        $host, $type, undef, $ent,
-        sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) },
-      master_deadline => $self->{master_deadline} );
+  $self->{async}->bgsend_and_start_lookup($host, $type, undef, $ent,
+    sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) },
+    master_deadline => $self->{master_deadline}
+  );
 }
 
+# Deprecated, was only used from DNSEval.pm?
 sub do_dns_lookup {
   my ($self, $rule, $type, $host) = @_;
 
-  $host = idn_to_ascii($host);
-  $host =~ s/\.\z//s;  # strip a redundant trailing dot
-  my $key = "dns:$type:$host";
-
   my $ent = {
-    key => $key,
-    zone => $host,  # serves to fetch other per-zone settings
-    type => "DNSBL-".$type,
-    rules => [ $rule ],
-    # id is filled in after we send the query below
+    rulename => $rule,
+    type => "DNSBL",
   };
-  $ent = $self->{async}->bgsend_and_start_lookup(
-      $host, $type, undef, $ent,
-      sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) },
-    master_deadline => $self->{master_deadline} );
-  $ent;
+  $self->{async}->bgsend_and_start_lookup($host, $type, undef, $ent,
+    sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) },
+    master_deadline => $self->{master_deadline}
+  );
 }
 
 ###########################################################################

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm Mon Nov  5 10:51:52 2018
@@ -115,7 +115,7 @@ package Mail::SpamAssassin::Plugin::ASN;
 use strict;
 use warnings;
 use re 'taint';
-use Mail::SpamAssassin;
+
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
 use Mail::SpamAssassin::Util qw(reverse_ip_address);
@@ -123,6 +123,8 @@ use Mail::SpamAssassin::Dns;
 
 our @ISA = qw(Mail::SpamAssassin::Plugin);
 
+our $txtdata_can_provide_a_list;
+
 sub new {
   my ($class, $mailsa) = @_;
   $class = ref($class) || $class;
@@ -131,6 +133,10 @@ sub new {
 
   $self->set_config($mailsa->{conf});
 
+  #$txtdata_can_provide_a_list = Net::DNS->VERSION >= 0.69;
+  #more robust version check from Damyan Ivanov - Bug 7095
+  $txtdata_can_provide_a_list = version->parse(Net::DNS->VERSION) >= version->parse('0.69');
+
   return $self;
 }
 
@@ -297,11 +303,10 @@ sub parsed_metadata {
     my $zone_index = $index;
     my $zone = $reversed_ip . '.' . $entry->{zone};
     my $key = "asnlookup-${zone_index}-$entry->{zone}";
-    my $ent = $pms->{async}->bgsend_and_start_lookup(
-        $zone, 'TXT', undef,
-        { key => $key, zone => $zone, rulename => 'asn_lookup' },
-        sub { my($ent, $pkt) = @_;
-              $self->process_dns_result($pms, $pkt, $zone_index) },
+    my $ent = $pms->{async}->bgsend_and_start_lookup($zone, 'TXT', undef,
+      { rulename => 'asn_lookup', type => 'ASN' },
+      sub { my($ent, $pkt) = @_;
+            $self->process_dns_result($pms, $pkt, $zone_index) },
       master_deadline => $pms->{master_deadline} );
     if ($ent) {
       dbg("asn: launched DNS TXT query for %s.%s in background",
@@ -357,8 +362,8 @@ sub process_dns_result {
   foreach my $rr (@answer) {
     dbg("asn: %s: lookup result packet: %s", $zone, $rr->string);
     next if $rr->type ne 'TXT';
-    my @strings = Net::DNS->VERSION >= 0.69 ? $rr->txtdata
-                                            : $rr->char_str_list;
+    my @strings = $txtdata_can_provide_a_list ? $rr->txtdata :
+      $rr->char_str_list; # historical
     next if !@strings;
     for (@strings) { utf8::encode($_) if utf8::is_utf8($_) }
 

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm Mon Nov  5 10:51:52 2018
@@ -471,9 +471,8 @@ OUTER:
                         { defined $current_tag_val{$1} ? $current_tag_val{$1}
                                                        : '' }ge;
       $query_domain = idn_to_ascii($query_domain);
-
-      # the $dnskey identifies this query in AsyncLoop's pending_lookups
-      my $dnskey = join(':', 'askdns', $query_type, $query_domain);
+      # used by process_response_packet
+      my $dnskey = "askdns:$query_type:$query_domain";
       dbg("askdns: expanded query %s, dns key %s", $query_domain, $dnskey);
 
       if ($query_domain eq '') {
@@ -487,12 +486,13 @@ OUTER:
                [$query_type, $answer_types_ref, $rules] );
         }
         # lauch a new DNS query for $query_type and $query_domain
-        my $ent = $pms->{async}->bgsend_and_start_lookup(
+        $pms->{async}->bgsend_and_start_lookup(
           $query_domain, $query_type, undef,
-          { key => $dnskey, zone => $query_domain, rulename => \@rulenames },
-          sub { my ($ent2,$pkt) = @_;
-                $self->process_response_packet($pms, $ent2, $pkt, $dnskey) },
-          master_deadline => $pms->{master_deadline} );
+          { rulename => \@rulenames, type => 'AskDNS' },
+          sub { my ($ent,$pkt) = @_;
+                $self->process_response_packet($pms, $ent, $pkt, $dnskey) },
+          master_deadline => $pms->{master_deadline}
+        );
       }
 
       last  if !@templ_tags;

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm Mon Nov  5 10:51:52 2018
@@ -405,9 +405,9 @@ sub check_dns_sender {
     return 0;
   }
 
+  $host = idn_to_ascii($host);
   dbg("dns: checking A and MX for host $host");
 
-  $host = idn_to_ascii($host);
   $self->do_sender_lookup($pms, $rule, 'A', $host);
   $self->do_sender_lookup($pms, $rule, 'MX', $host);
 
@@ -417,12 +417,9 @@ sub check_dns_sender {
 sub do_sender_lookup {
   my ($self, $pms, $rule, $type, $host) = @_;
 
-  my $key = "dns:$type:$host";
   my $ent = {
-    key => $key,
-    zone => $host,
-    type => "DNSBL-".$type,
     rulename => $rule,
+    type => "DNSBL-Sender",
   };
   $pms->{async}->bgsend_and_start_lookup(
     $host, $type, undef, $ent, sub {

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm Mon Nov  5 10:51:52 2018
@@ -226,8 +226,7 @@ C<check_uridnsbl()> to use this.
 Perform a RHSBL-style domain lookup against the contents of the NS records for
 each URI.  In other words, a URI using the domain C<foo.com> will cause an NS
 lookup to take place; assuming that domain has an NS of C<ns0.bar.com>, that
-will cause a lookup of C<ns0.bar.com.uriblzone.net>.  Note that hostnames are
-stripped from the domain used in the URI.
+will cause a lookup of C<ns0.bar.com.uriblzone.net>.
 
 C<NAME_OF_RULE> is the name of the rule to be used, C<rhsbl_zone> is the zone
 to look up domain names in, and C<lookuptype> is the type of lookup (B<TXT> or
@@ -347,31 +346,29 @@ sub check_dnsbl {
   return if $conf->{skip_uribl_checks};
   return if !$pms->is_dns_available();
 
-  $pms->{'uridnsbl_activerules'} = { };
-  $pms->{'uridnsbl_hits'} = { };
-  $pms->{'uridnsbl_seen_lookups'} = { };
+  $pms->{uridnsbl_activerules} = { };
+  $pms->{uridnsbl_hits} = { };
+  $pms->{uridnsbl_seen_lookups} = { };
 
   # only hit DNSBLs for active rules (defined and score != 0)
-  $pms->{'uridnsbl_active_rules_rhsbl'} = { };
-  $pms->{'uridnsbl_active_rules_rhsbl_ipsonly'} = { };
-  $pms->{'uridnsbl_active_rules_rhsbl_domsonly'} = { };
-  $pms->{'uridnsbl_active_rules_nsrhsbl'} = { };
-  $pms->{'uridnsbl_active_rules_fullnsrhsbl'} = { };
-  $pms->{'uridnsbl_active_rules_nsrevipbl'} = { };
-  $pms->{'uridnsbl_active_rules_arevipbl'} = { };
+  $pms->{uridnsbl_active_rules_rhsbl} = { };
+  $pms->{uridnsbl_active_rules_rhsbl_ipsonly} = { };
+  $pms->{uridnsbl_active_rules_rhsbl_domsonly} = { };
+  $pms->{uridnsbl_active_rules_nsrhsbl} = { };
+  $pms->{uridnsbl_active_rules_fullnsrhsbl} = { };
+  $pms->{uridnsbl_active_rules_nsrevipbl} = { };
+  $pms->{uridnsbl_active_rules_arevipbl} = { };
 
   foreach my $rulename (keys %{$conf->{uridnsbls}}) {
-    next unless ($conf->is_rule_active('body_evals',$rulename));
+    next if !$conf->{scores}->{$rulename};
 
     my $rulecf = $conf->{uridnsbls}->{$rulename};
-    my $tflags = $conf->{tflags}->{$rulename};
-    $tflags = ''  if !defined $tflags;
-    my %tfl = map { ($_,1) } split(' ',$tflags);
+    my %tfl = map { ($_,1) } split(/\s+/, $conf->{tflags}->{$rulename}||'');
 
     my $is_rhsbl = $rulecf->{is_rhsbl};
-    if (     $is_rhsbl && $tfl{'ips_only'}) {
+    if (     $is_rhsbl && $tfl{ips_only}) {
       $pms->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename} = 1;
-    } elsif ($is_rhsbl && $tfl{'domains_only'}) {
+    } elsif ($is_rhsbl && $tfl{domains_only}) {
       $pms->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename} = 1;
     } elsif ($is_rhsbl) {
       $pms->{uridnsbl_active_rules_rhsbl}->{$rulename} = 1;
@@ -380,10 +377,10 @@ sub check_dnsbl {
     } elsif ($rulecf->{is_nsrhsbl}) {
       $pms->{uridnsbl_active_rules_nsrhsbl}->{$rulename} = 1;
     } else {  # just a plain dnsbl rule (IP based), not a RHS rule (name-based)
-      if ($tfl{'a'}) {  # tflag 'a' explicitly
+      if ($tfl{a}) {  # tflag 'a' explicitly
         $pms->{uridnsbl_active_rules_arevipbl}->{$rulename} = 1;
       }
-      if ($tfl{'ns'} || !$tfl{'a'}) {  # tflag 'ns' explicitly, or default
+      if ($tfl{ns} || !$tfl{a}) {  # tflag 'ns' explicitly, or default
         $pms->{uridnsbl_active_rules_nsrevipbl}->{$rulename} = 1;
       }
     }
@@ -392,8 +389,7 @@ sub check_dnsbl {
   # get all domains in message
 
   # don't keep dereferencing this
-  my $skip_domains = $conf->{uridnsbl_skip_domains};
-  $skip_domains = {}  if !$skip_domains;
+  my $skip_domains = $conf->{uridnsbl_skip_domains} || {};
 
   # list of hashes to use in order
   my @uri_ordered;
@@ -556,7 +552,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -581,7 +577,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3,$4);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -609,7 +605,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -634,7 +630,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3,$4);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -662,7 +658,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -687,7 +683,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3,$4);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -715,7 +711,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -740,7 +736,7 @@ sub set_config {
     code => sub {
       my ($self, $key, $value, $line) = @_;
       local($1,$2,$3,$4);
-      if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
+      if ($value =~ /^(\w+)\s+(\S+)\s+(\S+)\s+(.*?)\s*$/) {
         my $rulename = $1;
         my $zone = $2;
         my $type = $3;
@@ -812,7 +808,7 @@ sub set_config {
 sub query_hosts_or_domains {
   my ($self, $pms, $hosthash_ref) = @_;
   my $conf = $pms->{conf};
-  my $seen_lookups = $pms->{'uridnsbl_seen_lookups'};
+  my $seen_lookups = $pms->{uridnsbl_seen_lookups};
 
   my $rhsblrules = $pms->{uridnsbl_active_rules_rhsbl};
   my $rhsbliprules = $pms->{uridnsbl_active_rules_rhsbl_ipsonly};
@@ -822,59 +818,52 @@ sub query_hosts_or_domains {
   my $nsreviprules = $pms->{uridnsbl_active_rules_nsrevipbl};
   my $areviprules = $pms->{uridnsbl_active_rules_arevipbl};
 
+  my @nsrules = (
+    keys %$nsrhsblrules,
+    keys %$fullnsrhsblrules,
+    keys %$nsreviprules,
+  );
+
   while (my($host,$domain) = each(%$hosthash_ref)) {
     $domain = lc $domain;  # just in case
     $host = lc $host;
     dbg("uridnsbl: considering host=$host, domain=$domain");
-    my $obj = { dom => $domain };
 
-    my ($is_ip, $single_dnsbl);
-    if ($host =~ /^\d+\.\d+\.\d+\.\d+$/) {
-      # only look up the IP if it is public and valid
-      if ($host =~ /^$IPV4_ADDRESS$/o && $host !~ /^$IP_PRIVATE$/o) {
-        my $obj = { dom => $host };
-        $self->lookup_dnsbl_for_ip($pms, $obj, $host);
-        # and check the IP in RHSBLs too
-        $domain = reverse_ip_address($host);
-        $single_dnsbl = 1;
-        $is_ip = 1;
-      }
-    }
-    else {
-      $single_dnsbl = 1;
-    }
-
-    if ($single_dnsbl) {
-      # rule names which look up a domain in the basic RHSBL subset
-      my @rhsblrules = keys %{$rhsblrules};
+    # rule names which look up a domain in the basic RHSBL subset
+    my @rhsblrules = keys %$rhsblrules;
 
-      # and add the "domains_only" and "ips_only" subsets as appropriate
-      if ($is_ip) {
-        push @rhsblrules, keys %{$rhsbliprules};
+    # IPv4 look-a-like / IPv6 address literal?
+    if ($host =~ /^\d+\.\d+\.\d+\.\d+$/ || $host =~ /^\[/) {
+      # only look up the IPv4 if it is public and valid
+      if ($host =~ /^$IPV4_ADDRESS$/o && $host !~ /^$IP_PRIVATE$/o) {
+        # Use IP in RHSBL lookups
+        $domain = $host;
       } else {
-        push @rhsblrules, keys %{$rhsbldomrules};
+        # Skip bogus/private/IPv6 completely
+        next;
       }
-
-      foreach my $rulename (@rhsblrules) {
-        my $rulecf = $conf->{uridnsbls}->{$rulename};
-        $self->lookup_single_dnsbl($pms, $obj, $rulename,
-                                   $domain, $rulecf->{zone}, $rulecf->{type});
-      }
-
+      # Add ips_only rules to RHSBL checks
+      push @rhsblrules, keys %$rhsbliprules;
+    } else {
       # perform NS+A or A queries to look up the domain in the non-RHSBL subset,
       # but only if there are active reverse-IP-URIBL rules
-      if ($host !~ /^$IPV4_ADDRESS$/o) {
-        if ( !$seen_lookups->{'NS:'.$domain} &&
-             (%$nsreviprules || %$nsrhsblrules || %$fullnsrhsblrules) ) {
-          $seen_lookups->{'NS:'.$domain} = 1;
-          $self->lookup_domain_ns($pms, $obj, $domain);
-        }
-        if (%$areviprules && !$seen_lookups->{'A:'.$host}) {
-          $seen_lookups->{'A:'.$host} = 1;
-          my $obj = { dom => $host };
-          $self->lookup_a_record($pms, $obj, $host);
-        }
-      }
+      if (!$seen_lookups->{"NS:$domain"} && @nsrules > 0) {
+        $seen_lookups->{"NS:$domain"} = 1;
+        $self->lookup_domain_ns($pms, $domain, \@nsrules);
+      }
+      if (!$seen_lookups->{"A:$host"} && %$areviprules) {
+        $seen_lookups->{"A:$host"} = 1;
+        $self->lookup_a_record($pms, $host, [keys %$areviprules]);
+      }
+      # Add domains_only rules to RHSBL checks
+      push @rhsblrules, keys %$rhsbldomrules;
+    }
+
+    # Launch RHSBL checks
+    foreach my $rulename (@rhsblrules) {
+      my $rulecf = $conf->{uridnsbls}->{$rulename};
+      $self->lookup_single_dnsbl($pms, $domain, $rulename,
+        $rulecf->{zone}, $rulecf->{type});
     }
   }
 }
@@ -882,25 +871,23 @@ sub query_hosts_or_domains {
 # ---------------------------------------------------------------------------
 
 sub lookup_domain_ns {
-  my ($self, $pms, $obj, $dom) = @_;
+  my ($self, $pms, $lookup, $rules) = @_;
+
+  $lookup = idn_to_ascii($lookup);
 
-  $dom = idn_to_ascii($dom);
-  my $key = "NS:" . $dom;
   my $ent = {
-    key => $key, zone => $dom, obj => $obj, type => "URI-NS",
-    rulename => 'uribl_ns',
+    rulename => [@$rules],
+    type => "URIBL",
+    lookup => $lookup,
+    domain => $lookup,
   };
-  # dig $dom ns
-  $ent = $pms->{async}->bgsend_and_start_lookup(
-    $dom, 'NS', undef, $ent,
-    sub { my ($ent2,$pkt) = @_;
-          $self->complete_ns_lookup($pms, $ent2, $pkt, $dom) },
-    master_deadline => $pms->{master_deadline} );
-  return $ent;
+  $pms->{async}->bgsend_and_start_lookup($lookup, 'NS', undef, $ent,
+    sub { my ($ent,$pkt) = @_; $self->complete_ns_lookup($pms, $ent, $pkt) },
+      master_deadline => $pms->{master_deadline} );
 }
 
 sub complete_ns_lookup {
-  my ($self, $pms, $ent, $pkt, $dom) = @_;
+  my ($self, $pms, $ent, $pkt) = @_;
 
   if (!$pkt) {
     # $pkt will be undef if the DNS query was aborted (e.g. timed out)
@@ -908,51 +895,59 @@ sub complete_ns_lookup {
     return;
   }
 
-  dbg("uridnsbl: complete_ns_lookup %s", $ent->{key});
+  dbg("uridnsbl: complete_ns_lookup %s %s", $ent->{key},
+    join(',', @{$ent->{rulename}}));
   my $conf = $pms->{conf};
   my @answer = $pkt->answer;
 
   my $nsrhsblrules = $pms->{uridnsbl_active_rules_nsrhsbl};
   my $fullnsrhsblrules = $pms->{uridnsbl_active_rules_fullnsrhsbl};
-  my $seen_lookups = $pms->{'uridnsbl_seen_lookups'};
+  my $areviprules = $pms->{uridnsbl_active_rules_arevipbl};
+  my $seen_lookups = $pms->{uridnsbl_seen_lookups};
 
   my $j = 0;
   foreach my $rr (@answer) {
     $j++;
     my $str = $rr->string;
-    next unless (defined($str) && defined($dom));
-    dbg("uridnsbl: got($j) NS for $dom: $str");
+    next unless defined $str && defined $ent->{lookup};
+    $str =~ s/.*\s//; # strip IN NS
+    dbg("uridnsbl: got($j) NS for $ent->{lookup}: $str");
 
     if ($rr->type eq 'NS') {
       my $nsmatch = lc $rr->nsdname;  # available since at least Net::DNS 0.14
       my $nsrhblstr = $nsmatch;
       my $fullnsrhblstr = $nsmatch;
 
-      if ($nsmatch =~ /^\d+\.\d+\.\d+\.\d+$/) {
+      # It would be very rare to receive IP as NS record, which is a
+      # misconfigure. Bind doesn't even allow that..
+      if ($nsmatch =~ /^\d+\.\d+\.\d+\.\d+$/ || index($nsmatch, ':') >= 0) {
 	# only look up the IP if it is public and valid
 	if ($nsmatch =~ /^$IPV4_ADDRESS$/o && $nsmatch !~ /^$IP_PRIVATE$/o) {
-	  $self->lookup_dnsbl_for_ip($pms, $ent->{obj}, $nsmatch);
-	}
-        $nsrhblstr = $nsmatch;
+          # Use IP in RHSBL lookups
+          #$nsrhblstr = $nsmatch; # already set
+        } else {
+          # Skip bogus/private/IPv6 completely
+          next;
+        }
       }
       else {
-        if (!$seen_lookups->{'A:'.$nsmatch}) {
-          $seen_lookups->{'A:'.$nsmatch} = 1;
-          $self->lookup_a_record($pms, $ent->{obj}, $nsmatch);
+        if (!$seen_lookups->{"A:$nsmatch"}) {
+          $seen_lookups->{"A:$nsmatch"} = 1;
+          $self->lookup_a_record($pms, $nsmatch, [keys %$areviprules]);
         }
         $nsrhblstr = $self->{main}->{registryboundaries}->trim_domain($nsmatch);
       }
 
       foreach my $rulename (keys %{$nsrhsblrules}) {
         my $rulecf = $conf->{uridnsbls}->{$rulename};
-        $self->lookup_single_dnsbl($pms, $ent->{obj}, $rulename,
-                                  $nsrhblstr, $rulecf->{zone}, $rulecf->{type});
+        $self->lookup_single_dnsbl($pms, $nsrhblstr, $rulename,
+          $rulecf->{zone}, $rulecf->{type});
       }
 
       foreach my $rulename (keys %{$fullnsrhsblrules}) {
         my $rulecf = $conf->{uridnsbls}->{$rulename};
-        $self->lookup_single_dnsbl($pms, $ent->{obj}, $rulename,
-                                  $fullnsrhblstr, $rulecf->{zone}, $rulecf->{type});
+        $self->lookup_single_dnsbl($pms, $fullnsrhblstr, $rulename,
+          $rulecf->{zone}, $rulecf->{type});
       }
     }
   }
@@ -961,33 +956,33 @@ sub complete_ns_lookup {
 # ---------------------------------------------------------------------------
 
 sub lookup_a_record {
-  my ($self, $pms, $obj, $hname) = @_;
+  my ($self, $pms, $lookup, $rules) = @_;
+
+  $lookup = idn_to_ascii($lookup);
 
-  $hname = idn_to_ascii($hname);
-  my $key = "A:" . $hname;
   my $ent = {
-    key => $key, zone => $hname, obj => $obj, type => "URI-A",
-    rulename => 'uribl_a',
+    rulename => [@$rules],
+    type => "URIBL",
+    lookup => $lookup,
+    domain => $lookup,
   };
-  # dig $hname a
-  $ent = $pms->{async}->bgsend_and_start_lookup(
-    $hname, 'A', undef, $ent,
-    sub { my ($ent2,$pkt) = @_;
-          $self->complete_a_lookup($pms, $ent2, $pkt, $hname) },
-    master_deadline => $pms->{master_deadline} );
-  return $ent;
+  $pms->{async}->bgsend_and_start_lookup($lookup, 'A', undef, $ent,
+    sub { my ($ent,$pkt) = @_;
+          $self->complete_a_lookup($pms, $ent, $pkt) },
+    master_deadline => $pms->{master_deadline}
+  );
 }
 
 sub complete_a_lookup {
-  my ($self, $pms, $ent, $pkt, $hname) = @_;
+  my ($self, $pms, $ent, $pkt) = @_;
 
   if (!$pkt) {
     # $pkt will be undef if the DNS query was aborted (e.g. timed out)
     dbg("uridnsbl: complete_a_lookup aborted %s", $ent->{key});
     return;
   }
-  dbg("uridnsbl: complete_a_lookup %s", $ent->{key});
-  $hname = ''  if !defined $hname;
+  dbg("uridnsbl: complete_a_lookup %s %s", $ent->{key},
+    join(',', @{$ent->{rulename}}));
   my $j = 0;
   my @answer = $pkt->answer;
   foreach my $rr (@answer) {
@@ -997,55 +992,49 @@ sub complete_a_lookup {
     my $ip_address = $rr->UNIVERSAL::can('address') ? $rr->address
                                                     : $rr->rdatastr;
     dbg("uridnsbl: complete_a_lookup got(%d) A for %s: %s",
-        $j, $hname, $ip_address);
-    $self->lookup_dnsbl_for_ip($pms, $ent->{obj}, $ip_address);
+        $j, $ent->{lookup}, $ip_address);
+    $self->lookup_dnsbl_for_ip($pms, $ip_address, $ent->{rulename});
   }
 }
 
 # ---------------------------------------------------------------------------
 
 sub lookup_dnsbl_for_ip {
-  my ($self, $pms, $obj, $ip) = @_;
-
-  if ($ip !~ /^$IPV4_ADDRESS$/o) {
-    warn "lookup_dnsbl_for_ip: not an IPv4 address: $ip\n";
-    return;
-  }
-  my $revip = reverse_ip_address($ip);
+  my ($self, $pms, $ip, $rules) = @_;
 
   my $conf = $pms->{conf};
-  my $tflags = $conf->{tflags};
-  my $cfns = $pms->{uridnsbl_active_rules_nsrevipbl};
-  my $cfa  = $pms->{uridnsbl_active_rules_arevipbl};
-  foreach my $rulename (keys %$cfa, keys %$cfns) {
+  foreach my $rulename (@$rules) {
     my $rulecf = $conf->{uridnsbls}->{$rulename};
-
-    # ips_only/domains_only lookups should not act on this kind of BL
-    next  if defined $tflags->{$rulename} &&
-             $tflags->{$rulename} =~ /\b(?:ips_only|domains_only)\b/;
-
-    $self->lookup_single_dnsbl($pms, $obj, $rulename,
-			       $revip, $rulecf->{zone}, $rulecf->{type});
+    $self->lookup_single_dnsbl($pms, $ip, $rulename,
+      $rulecf->{zone}, $rulecf->{type});
   }
 }
 
 sub lookup_single_dnsbl {
-  my ($self, $pms, $obj, $rulename, $lookupstr, $dnsbl, $qtype) = @_;
+  my ($self, $pms, $lookup, $rulename, $zone, $type) = @_;
+
+  $lookup = idn_to_ascii($lookup);
 
-  $lookupstr = idn_to_ascii($lookupstr);
-  $dnsbl = idn_to_ascii($dnsbl);
+  my $qkey = "$rulename:$lookup:$zone:$type";
+  return if exists $pms->{uridnsbl_seen_lookups}{$qkey};
+  $pms->{uridnsbl_seen_lookups}{$qkey} = 1;
+
+  # IP queries need to be reversed
+  # Let's do it here, and only here..
+  my $domain = $lookup;
+  if ($lookup =~ /^\d+\.\d+\.\d+\.\d+$/) {
+    $lookup = reverse_ip_address($lookup);
+  }
 
-  my $key = "DNSBL:" . $lookupstr . ':' . $dnsbl;
   my $ent = {
-    key => $key, zone => $dnsbl, obj => $obj, type => 'URI-DNSBL',
     rulename => $rulename,
+    type => "URIBL",
+    lookup => $lookup,
+    domain => $domain,
   };
-  $ent = $pms->{async}->bgsend_and_start_lookup(
-    $lookupstr.".".$dnsbl, $qtype, undef, $ent,
-    sub { my ($ent2,$pkt) = @_;
-          $self->complete_dnsbl_lookup($pms, $ent2, $pkt) },
-    master_deadline => $pms->{master_deadline} );
-  return $ent;
+  $pms->{async}->bgsend_and_start_lookup("$lookup.$zone", $type, undef, $ent,
+    sub { my ($ent,$pkt) = @_; $self->complete_dnsbl_lookup($pms, $ent, $pkt) },
+    master_deadline => $pms->{master_deadline});
 }
 
 sub complete_dnsbl_lookup {
@@ -1058,11 +1047,9 @@ sub complete_dnsbl_lookup {
     return;
   }
 
-  dbg("uridnsbl: complete_dnsbl_lookup %s %s", $ent->{rulename}, $ent->{key});
+  dbg("uridnsbl: complete_dnsbl_lookup $ent->{key} $ent->{rulename}");
   my $conf = $pms->{conf};
 
-  my $zone = $ent->{zone};
-  my $dom = $ent->{obj}->{dom};
   my $rulename = $ent->{rulename};
   my $rulecf = $conf->{uridnsbls}->{$rulename};
 
@@ -1077,7 +1064,7 @@ sub complete_dnsbl_lookup {
       # Net::DNS::RR::A::address() is available since Net::DNS 0.69
       $rdatastr = $rr->UNIVERSAL::can('address') ? $rr->address
                                                  : $rr->rdatastr;
-      if ($rdatastr =~ m/^$IPV4_ADDRESS$/o) {
+      if ($rdatastr =~ /^$IPV4_ADDRESS$/o) {
         $rdatanum = Mail::SpamAssassin::Util::my_inet_aton($rdatastr);
       }
     } elsif ($rr_type eq 'TXT') {
@@ -1093,7 +1080,7 @@ sub complete_dnsbl_lookup {
     my $subtest = $rulecf->{subtest};
 
     dbg("uridnsbl: %s . %s -> %s, %s%s",
-        $dom, $zone, $rdatastr, $rulename,
+        $ent->{domain}, $ent->{zone}, $rdatastr, $rulename,
         !defined $subtest ? '' : ', subtest:'.$subtest);
 
     my $match;
@@ -1101,7 +1088,7 @@ sub complete_dnsbl_lookup {
       # this zone is a simple rule, not a set of subrules
       # skip any A record that isn't on 127/8
       if ($rr_type eq 'A' && $rdatastr !~ /^127\./) {
-	warn("uridnsbl: bogus rr for domain=$dom, rule=$rulename, id=" .
+	warn("uridnsbl: bogus rr for domain=$ent->{domain}, rule=$rulename, id=" .
             $pkt->header->id." rr=".$rr->string);
 	next;
       }
@@ -1118,41 +1105,29 @@ sub complete_dnsbl_lookup {
       : 0;  
 
       dbg("uridnsbl: %s . %s -> %s, %s, %08x %s %s",
-          $dom, $zone, $rdatastr, $rulename, $rdatanum,
+          $ent->{domain}, $ent->{zone}, $rdatastr, $rulename, $rdatanum,
           !defined $n2 ? sprintf('& %08x', $n1)
           : $n1 == $n2 ? sprintf('== %08x', $n1)
           :              sprintf('%08x%s%08x', $n1,$delim,$n2),
           $match ? 'match' : 'no');
     }
-    $self->got_dnsbl_hit($pms, $ent, $rdatastr, $dom, $rulename) if $match;
+    $self->got_dnsbl_hit($pms, $ent, $rdatastr, $rulename) if $match;
   }
 }
 
 sub got_dnsbl_hit {
-  my ($self, $pms, $ent, $str, $dom, $rulename) = @_;
+  my ($self, $pms, $ent, $str, $rulename) = @_;
 
   $str =~ s/\s+/  /gs;	# long whitespace => short
-  dbg("uridnsbl: domain \"$dom\" listed ($rulename): $str");
+  dbg("uridnsbl: domain \"$ent->{domain}\" listed ($rulename): $str");
 
-  if (!defined $pms->{uridnsbl_hits}->{$rulename}) {
-    $pms->{uridnsbl_hits}->{$rulename} = { };
-  };
-  $pms->{uridnsbl_hits}->{$rulename}->{$dom} = 1;
+  $pms->{uridnsbl_hits}->{$rulename}->{$ent->{domain}} = 1;
 
-  if ( $pms->{uridnsbl_active_rules_nsrevipbl}->{$rulename}
-    || $pms->{uridnsbl_active_rules_arevipbl}->{$rulename}
-    || $pms->{uridnsbl_active_rules_nsrhsbl}->{$rulename}
-    || $pms->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename}
-    || $pms->{uridnsbl_active_rules_rhsbl}->{$rulename}
-    || $pms->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename}
-    || $pms->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename})
-  {
-    # TODO: this needs to handle multiple domain hits per rule
-    $pms->clear_test_state();
-    my $uris = join (' ', keys %{$pms->{uridnsbl_hits}->{$rulename}});
-    $pms->test_log ("URIs: $uris");
-    $pms->got_hit ($rulename, "");
-  }
+  # TODO: this needs to handle multiple domain hits per rule
+  $pms->clear_test_state();
+  my $uris = join(' ', keys %{$pms->{uridnsbl_hits}->{$rulename}});
+  $pms->test_log("URIs: $uris");
+  $pms->got_hit($rulename, '', ruletype => 'eval');
 }
 
 # ---------------------------------------------------------------------------

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URILocalBL.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URILocalBL.pm?rev=1845773&r1=1845772&r2=1845773&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URILocalBL.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URILocalBL.pm Mon Nov  5 10:51:52 2018
@@ -368,12 +368,12 @@ sub check_uri_local_bl {
     next unless defined $info->{types}->{a};
 
     my %hosts = %{$info->{hosts}}; # evade hash reset by copy
-    HOST: while (my($host, $domain) = each %hosts) {
+    while (my($host, $domain) = each %hosts) {
       if (defined $ruleconf->{exclusions}{lc($domain)}) {
         dbg("excluded $host, domain $domain matches");
-        next HOST;
+        next;
       }
-      if ($host =~ /^$IP_ADDRESS$/o) {
+      elsif ($host =~ /^$IP_ADDRESS$/o) {
         if ($self->_check_host($pms, $rulename, $host, [$host])) {
           # if hit, rule is done
           return 0;
@@ -390,23 +390,19 @@ sub check_uri_local_bl {
   return 0 if !$pms->is_dns_available();
 
   foreach my $host (keys %found_hosts) {
-    dbg("launching A/AAAA lookup for $host");
     $host = idn_to_ascii($host);
+    dbg("launching A/AAAA lookup for $host");
     # launch dns
-    my $key = "urilocalbl:$host:A";
-    my $ent = $pms->{async}->bgsend_and_start_lookup($host, 'A', undef,
-      { key => $key, host => $host, rulename => $rulename },
-      sub { my($ent, $pkt) = @_;
-            $self->_finish_lookup($pms, $ent, $pkt); },
+    $pms->{async}->bgsend_and_start_lookup($host, 'A', undef,
+      { rulename => $rulename, host => $host, type => 'URILocalBL' },
+      sub { my($ent, $pkt) = @_; $self->_finish_lookup($pms, $ent, $pkt); },
       master_deadline => $pms->{master_deadline}
     );
     # also IPv6 if database supports
     if ($self->{main}->{geodb}->can('country_v6')) {
-      $key = "urilocalbl:$host:AAAA";
-      $ent = $pms->{async}->bgsend_and_start_lookup($host, 'AAAA', undef,
-        { key => $key, host => $host, rulename => $rulename },
-        sub { my($ent, $pkt) = @_;
-              $self->_finish_lookup($pms, $ent, $pkt); },
+      $pms->{async}->bgsend_and_start_lookup($host, 'AAAA', undef,
+        { rulename => $rulename, host => $host, type => 'URILocalBL' },
+        sub { my($ent, $pkt) = @_; $self->_finish_lookup($pms, $ent, $pkt); },
         master_deadline => $pms->{master_deadline}
       );
     }