309
352
$self->{dns_not_available} = 0;
312
$scanner->{'uridnsbl_activerules'} = { };
313
$scanner->{'uridnsbl_hits'} = { };
314
$scanner->{'uridnsbl_seen_domain'} = { };
355
$pms->{'uridnsbl_activerules'} = { };
356
$pms->{'uridnsbl_hits'} = { };
357
$pms->{'uridnsbl_seen_lookups'} = { };
316
359
# only hit DNSBLs for active rules (defined and score != 0)
317
$scanner->{'uridnsbl_active_rules_rhsbl'} = { };
318
$scanner->{'uridnsbl_active_rules_rhsbl_ipsonly'} = { };
319
$scanner->{'uridnsbl_active_rules_rhsbl_domsonly'} = { };
320
$scanner->{'uridnsbl_active_rules_nsrhsbl'} = { };
321
$scanner->{'uridnsbl_active_rules_fullnsrhsbl'} = { };
322
$scanner->{'uridnsbl_active_rules_revipbl'} = { };
324
foreach my $rulename (keys %{$scanner->{conf}->{uridnsbls}}) {
325
next unless ($scanner->{conf}->is_rule_active('body_evals',$rulename));
327
my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
328
my $tflags = $scanner->{conf}->{tflags}->{$rulename};
360
$pms->{'uridnsbl_active_rules_rhsbl'} = { };
361
$pms->{'uridnsbl_active_rules_rhsbl_ipsonly'} = { };
362
$pms->{'uridnsbl_active_rules_rhsbl_domsonly'} = { };
363
$pms->{'uridnsbl_active_rules_nsrhsbl'} = { };
364
$pms->{'uridnsbl_active_rules_fullnsrhsbl'} = { };
365
$pms->{'uridnsbl_active_rules_nsrevipbl'} = { };
366
$pms->{'uridnsbl_active_rules_arevipbl'} = { };
368
foreach my $rulename (keys %{$conf->{uridnsbls}}) {
369
next unless ($conf->is_rule_active('body_evals',$rulename));
371
my $rulecf = $conf->{uridnsbls}->{$rulename};
372
my $tflags = $conf->{tflags}->{$rulename};
329
373
$tflags = '' if !defined $tflags;
374
my %tfl = map { ($_,1) } split(' ',$tflags);
331
if ($rulecf->{is_rhsbl} && $tflags =~ /\b ips_only \b/x) {
332
$scanner->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename} = 1;
333
} elsif ($rulecf->{is_rhsbl} && $tflags =~ /\b domains_only \b/x) {
334
$scanner->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename} = 1;
335
} elsif ($rulecf->{is_rhsbl}) {
336
$scanner->{uridnsbl_active_rules_rhsbl}->{$rulename} = 1;
376
my $is_rhsbl = $rulecf->{is_rhsbl};
377
if ( $is_rhsbl && $tfl{'ips_only'}) {
378
$pms->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename} = 1;
379
} elsif ($is_rhsbl && $tfl{'domains_only'}) {
380
$pms->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename} = 1;
381
} elsif ($is_rhsbl) {
382
$pms->{uridnsbl_active_rules_rhsbl}->{$rulename} = 1;
337
383
} elsif ($rulecf->{is_fullnsrhsbl}) {
338
$scanner->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename} = 1;
384
$pms->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename} = 1;
339
385
} elsif ($rulecf->{is_nsrhsbl}) {
340
$scanner->{uridnsbl_active_rules_nsrhsbl}->{$rulename} = 1;
342
$scanner->{uridnsbl_active_rules_revipbl}->{$rulename} = 1;
386
$pms->{uridnsbl_active_rules_nsrhsbl}->{$rulename} = 1;
387
} else { # just a plain dnsbl rule (IP based), not a RHS rule (name-based)
388
if ($tfl{'a'}) { # tflag 'a' explicitly
389
$pms->{uridnsbl_active_rules_arevipbl}->{$rulename} = 1;
391
if ($tfl{'ns'} || !$tfl{'a'}) { # tflag 'ns' explicitly, or default
392
$pms->{uridnsbl_active_rules_nsrevipbl}->{$rulename} = 1;
346
397
# get all domains in message
348
399
# don't keep dereferencing this
349
my $skip_domains = $scanner->{main}->{conf}->{uridnsbl_skip_domains};
400
my $skip_domains = $conf->{uridnsbl_skip_domains};
350
401
$skip_domains = {} if !$skip_domains;
352
403
# list of hashes to use in order
355
406
# Generate the full list of html-parsed domains.
356
my $uris = $scanner->get_uri_detail_list();
407
my $uris = $pms->get_uri_detail_list();
358
409
# go from uri => info to uri_ordered
395
# take the usable domains and add to the ordered list
396
foreach ( keys %{ $info->{domains} } ) {
397
if (exists $skip_domains->{$_}) {
398
dbg("uridnsbl: domain $_ in skip list");
446
# take the usable domains and add them to the ordered list
447
while (my($host,$domain) = each( %{$info->{hosts}} )) {
448
if ($skip_domains->{$domain}) {
449
dbg("uridnsbl: domain $domain in skip list, host $host");
451
# use hostname as a key, and drag along the stripped domain name part
452
$uri_ordered[$entry]->{$host} = $domain;
401
$uri_ordered[$entry]->{$_} = 1;
405
# at this point, @uri_ordered is an ordered array of uri hashes
408
my $umd = $scanner->{main}->{conf}->{uridnsbl_max_domains};
409
while (keys %domlist < $umd && @uri_ordered) {
457
# at this point, @uri_ordered is an ordered array of hostname hashes
459
my %hostlist; # keys are host names, values are their domain parts
461
my $umd = $conf->{uridnsbl_max_domains};
462
while (keys %hostlist < $umd && @uri_ordered) {
410
463
my $array = shift @uri_ordered;
411
464
next unless $array;
413
466
# run through and find the new domains in this grouping
414
my @domains = grep(!$domlist{$_}, keys %{$array});
415
next unless @domains;
467
my @hosts = grep(!$hostlist{$_}, keys %{$array});
417
# the new domains are all useful, just add them in
418
if (keys(%domlist) + @domains <= $umd) {
470
# the new hosts are all useful, just add them in
471
if (keys(%hostlist) + @hosts <= $umd) {
472
foreach my $host (@hosts) {
473
$hostlist{$host} = $array->{$host};
477
dbg("uridnsbl: more than $umd URIs, picking a subset");
424
478
# trim down to a limited number - pick randomly
425
while (@domains && keys %domlist < $umd) {
426
my $r = int rand (scalar @domains);
427
$domlist{splice (@domains, $r, 1)} = 1;
479
while (@hosts && keys %hostlist < $umd) {
480
my $r = int rand(scalar @hosts);
481
my $picked_host = splice(@hosts, $r, 1);
482
$hostlist{$picked_host} = $array->{$picked_host};
487
my @hnames = keys %hostlist;
488
$pms->set_tag('URIHOSTS',
489
@hnames == 1 ? $hnames[0] : \@hnames) if @hnames;
490
my @dnames = values %hostlist;
491
$pms->set_tag('URIDOMAINS',
492
@dnames == 1 ? $dnames[0] : \@dnames) if @dnames;
433
dbg("uridnsbl: domains to query: ".join(' ',keys %domlist));
434
foreach my $dom (keys %domlist) {
435
$self->query_domain ($scanner, $dom);
495
$self->query_hosts_or_domains($pms, \%hostlist);
758
817
# ---------------------------------------------------------------------------
761
my ($self, $scanner, $dom) = @_;
763
#warn "uridnsbl: domain $dom\n";
767
return if $scanner->{uridnsbl_seen_domain}->{$dom};
768
$scanner->{uridnsbl_seen_domain}->{$dom} = 1;
769
$self->log_dns_result("querying domain $dom");
771
my $obj = { dom => $dom };
773
my $tflags = $scanner->{conf}->{tflags};
774
my $cf = $scanner->{uridnsbl_active_rules_revipbl};
776
my ($is_ip, $single_dnsbl);
777
if ($dom =~ /^\d+\.\d+\.\d+\.\d+$/) {
778
my $IPV4_ADDRESS = IPV4_ADDRESS;
779
my $IP_PRIVATE = IP_PRIVATE;
780
# only look up the IP if it is public and valid
781
if ($dom =~ /^$IPV4_ADDRESS$/ && $dom !~ /^$IP_PRIVATE$/) {
782
$self->lookup_dnsbl_for_ip($scanner, $obj, $dom);
783
# and check the IP in RHSBLs too
785
if ($dom =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
786
$dom = "$4.$3.$2.$1";
796
my $rhsblrules = $scanner->{uridnsbl_active_rules_rhsbl};
797
my $rhsbliprules = $scanner->{uridnsbl_active_rules_rhsbl_ipsonly};
798
my $rhsbldomrules = $scanner->{uridnsbl_active_rules_rhsbl_domsonly};
799
my $nsrhsblrules = $scanner->{uridnsbl_active_rules_nsrhsbl};
800
my $fullnsrhsblrules = $scanner->{uridnsbl_active_rules_fullnsrhsbl};
801
my $reviprules = $scanner->{uridnsbl_active_rules_revipbl};
804
# look up the domain in the basic RHSBL subset
805
my @rhsbldoms = keys %{$rhsblrules};
807
# and add the "domains_only" and "ips_only" subsets as appropriate
809
push @rhsbldoms, keys %{$rhsbliprules};
811
push @rhsbldoms, keys %{$rhsbldomrules};
814
foreach my $rulename (@rhsbldoms) {
815
my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
816
$self->lookup_single_dnsbl($scanner, $obj, $rulename,
817
$dom, $rulecf->{zone}, $rulecf->{type});
820
$scanner->register_async_rule_start($rulename);
823
# perform NS, A lookups to look up the domain in the non-RHSBL subset,
824
# but only if there are active reverse-IP-URIBL rules
825
if ($dom !~ /^\d+\.\d+\.\d+\.\d+$/ &&
826
(scalar keys %{$reviprules} ||
827
scalar keys %{$nsrhsblrules} ||
828
scalar keys %{$fullnsrhsblrules}))
830
$self->lookup_domain_ns($scanner, $obj, $dom);
834
# note that these rules are now underway. important: unless the
835
# rule hits, in the current design, these will not be considered
836
# "finished" until harvest_dnsbl_queries() completes
837
foreach my $rulename (keys %{$reviprules}) {
838
$scanner->register_async_rule_start($rulename);
819
sub query_hosts_or_domains {
820
my ($self, $pms, $hosthash_ref) = @_;
821
my $conf = $pms->{conf};
822
my $seen_lookups = $pms->{'uridnsbl_seen_lookups'};
824
my $rhsblrules = $pms->{uridnsbl_active_rules_rhsbl};
825
my $rhsbliprules = $pms->{uridnsbl_active_rules_rhsbl_ipsonly};
826
my $rhsbldomrules = $pms->{uridnsbl_active_rules_rhsbl_domsonly};
827
my $nsrhsblrules = $pms->{uridnsbl_active_rules_nsrhsbl};
828
my $fullnsrhsblrules = $pms->{uridnsbl_active_rules_fullnsrhsbl};
829
my $nsreviprules = $pms->{uridnsbl_active_rules_nsrevipbl};
830
my $areviprules = $pms->{uridnsbl_active_rules_arevipbl};
832
while (my($host,$domain) = each(%$hosthash_ref)) {
833
$domain = lc $domain; # just in case
835
dbg("uridnsbl: considering host=$host, domain=$domain");
836
my $obj = { dom => $domain };
838
my ($is_ip, $single_dnsbl);
839
if ($host =~ /^\d+\.\d+\.\d+\.\d+$/) {
840
my $IPV4_ADDRESS = IPV4_ADDRESS;
841
my $IP_PRIVATE = IP_PRIVATE;
842
# only look up the IP if it is public and valid
843
if ($host =~ /^$IPV4_ADDRESS$/o && $host !~ /^$IP_PRIVATE$/o) {
844
my $obj = { dom => $host };
845
$self->lookup_dnsbl_for_ip($pms, $obj, $host);
846
# and check the IP in RHSBLs too
848
if ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
849
$domain = "$4.$3.$2.$1";
860
# rule names which look up a domain in the basic RHSBL subset
861
my @rhsblrules = keys %{$rhsblrules};
863
# and add the "domains_only" and "ips_only" subsets as appropriate
865
push @rhsblrules, keys %{$rhsbliprules};
867
push @rhsblrules, keys %{$rhsbldomrules};
870
foreach my $rulename (@rhsblrules) {
871
my $rulecf = $conf->{uridnsbls}->{$rulename};
872
$self->lookup_single_dnsbl($pms, $obj, $rulename,
873
$domain, $rulecf->{zone}, $rulecf->{type});
875
# note that these rules are now underway. important: unless the
876
# rule hits, in the current design, these will not be considered
877
# "finished" until harvest_dnsbl_queries() completes
878
$pms->register_async_rule_start($rulename);
881
# perform NS+A or A queries to look up the domain in the non-RHSBL subset,
882
# but only if there are active reverse-IP-URIBL rules
883
if ($host !~ /^\d+\.\d+\.\d+\.\d+$/) {
884
if ( !$seen_lookups->{'NS:'.$domain} &&
885
(%$nsreviprules || %$nsrhsblrules || %$fullnsrhsblrules) ) {
886
$seen_lookups->{'NS:'.$domain} = 1;
887
$self->lookup_domain_ns($pms, $obj, $domain);
889
if (%$areviprules && !$seen_lookups->{'A:'.$host}) {
890
$seen_lookups->{'A:'.$host} = 1;
891
my $obj = { dom => $host };
892
$self->lookup_a_record($pms, $obj, $host);
893
$pms->register_async_rule_start($_) for keys %$areviprules;
842
900
# ---------------------------------------------------------------------------
844
902
sub lookup_domain_ns {
845
my ($self, $scanner, $obj, $dom) = @_;
847
my $key = "NS:".$dom;
848
return if $scanner->{async}->get_lookup($key);
903
my ($self, $pms, $obj, $dom, $rulename) = @_;
905
my $key = "NS:" . $dom;
907
key => $key, zone => $dom, obj => $obj, type => "URI-NS",
908
rulename => $rulename,
851
my $ent = $self->start_lookup($scanner, $dom, 'NS',
852
$self->res_bgsend($scanner, $dom, 'NS', $key),
911
$ent = $pms->{async}->bgsend_and_start_lookup(
912
$dom, 'NS', undef, $ent,
913
sub { my ($ent2,$pkt) = @_;
914
$self->complete_ns_lookup($pms, $ent2, $pkt, $dom) },
915
master_deadline => $pms->{master_deadline} );
857
920
sub complete_ns_lookup {
858
my ($self, $scanner, $ent, $dom) = @_;
860
my $packet = $ent->{response_packet};
861
my @answer = !defined $packet ? () : $packet->answer;
921
my ($self, $pms, $ent, $pkt, $dom) = @_;
924
# $pkt will be undef if the DNS query was aborted (e.g. timed out)
925
dbg("uridnsbl: complete_ns_lookup aborted %s", $ent->{key});
929
dbg("uridnsbl: complete_ns_lookup %s", $ent->{key});
930
my $conf = $pms->{conf};
931
my @answer = $pkt->answer;
863
933
my $IPV4_ADDRESS = IPV4_ADDRESS;
864
934
my $IP_PRIVATE = IP_PRIVATE;
865
my $nsrhsblrules = $scanner->{uridnsbl_active_rules_nsrhsbl};
866
my $fullnsrhsblrules = $scanner->{uridnsbl_active_rules_fullnsrhsbl};
935
my $nsrhsblrules = $pms->{uridnsbl_active_rules_nsrhsbl};
936
my $fullnsrhsblrules = $pms->{uridnsbl_active_rules_fullnsrhsbl};
937
my $seen_lookups = $pms->{'uridnsbl_seen_lookups'};
868
940
foreach my $rr (@answer) {
869
942
my $str = $rr->string;
870
943
next unless (defined($str) && defined($dom));
871
$self->log_dns_result ("NSs for $dom: $str");
944
dbg("uridnsbl: got($j) NS for $dom: $str");
873
946
if ($str =~ /IN\s+NS\s+(\S+)/) {
875
949
my $nsrhblstr = $nsmatch;
876
950
my $fullnsrhblstr = $nsmatch;
877
$fullnsrhblstr =~ s/\.$//;
879
if ($nsmatch =~ /^\d+\.\d+\.\d+\.\d+\.?$/) {
952
if ($nsmatch =~ /^\d+\.\d+\.\d+\.\d+$/) {
881
953
# only look up the IP if it is public and valid
882
if ($nsmatch =~ /^$IPV4_ADDRESS$/ && $nsmatch !~ /^$IP_PRIVATE$/) {
883
$self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $nsmatch);
954
if ($nsmatch =~ /^$IPV4_ADDRESS$/o && $nsmatch !~ /^$IP_PRIVATE$/o) {
955
$self->lookup_dnsbl_for_ip($pms, $ent->{obj}, $nsmatch);
885
957
$nsrhblstr = $nsmatch;
888
$self->lookup_a_record($scanner, $ent->{obj}, $nsmatch);
960
if (!$seen_lookups->{'A:'.$nsmatch}) {
961
$seen_lookups->{'A:'.$nsmatch} = 1;
962
$self->lookup_a_record($pms, $ent->{obj}, $nsmatch);
889
964
$nsrhblstr = Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain($nsmatch);
892
967
foreach my $rulename (keys %{$nsrhsblrules}) {
893
my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
894
$self->lookup_single_dnsbl($scanner, $ent->{obj}, $rulename,
968
my $rulecf = $conf->{uridnsbls}->{$rulename};
969
$self->lookup_single_dnsbl($pms, $ent->{obj}, $rulename,
895
970
$nsrhblstr, $rulecf->{zone}, $rulecf->{type});
897
$scanner->register_async_rule_start($rulename);
972
$pms->register_async_rule_start($rulename);
900
975
foreach my $rulename (keys %{$fullnsrhsblrules}) {
901
my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
902
$self->lookup_single_dnsbl($scanner, $ent->{obj}, $rulename,
976
my $rulecf = $conf->{uridnsbls}->{$rulename};
977
$self->lookup_single_dnsbl($pms, $ent->{obj}, $rulename,
903
978
$fullnsrhblstr, $rulecf->{zone}, $rulecf->{type});
905
$scanner->register_async_rule_start($rulename);
980
$pms->register_async_rule_start($rulename);
911
986
# ---------------------------------------------------------------------------
913
988
sub lookup_a_record {
914
my ($self, $scanner, $obj, $hname) = @_;
916
my $key = "A:".$hname;
917
return if $scanner->{async}->get_lookup($key);
989
my ($self, $pms, $obj, $hname, $rulename) = @_;
991
my $key = "A:" . $hname;
993
key => $key, zone => $hname, obj => $obj, type => "URI-A",
994
rulename => $rulename,
920
my $ent = $self->start_lookup($scanner, $hname, 'A',
921
$self->res_bgsend($scanner, $hname, 'A', $key),
997
$ent = $pms->{async}->bgsend_and_start_lookup(
998
$hname, 'A', undef, $ent,
999
sub { my ($ent2,$pkt) = @_;
1000
$self->complete_a_lookup($pms, $ent2, $pkt, $hname) },
1001
master_deadline => $pms->{master_deadline} );
926
1006
sub complete_a_lookup {
927
my ($self, $scanner, $ent, $hname) = @_;
929
my $packet = $ent->{response_packet};
930
my @answer = !defined $packet ? () : $packet->answer;
1007
my ($self, $pms, $ent, $pkt, $hname) = @_;
1010
# $pkt will be undef if the DNS query was aborted (e.g. timed out)
1011
dbg("uridnsbl: complete_a_lookup aborted %s", $ent->{key});
1015
dbg("uridnsbl: complete_a_lookup %s", $ent->{key});
1016
my @answer = $pkt->answer;
931
1018
foreach my $rr (@answer) {
932
1020
my $str = $rr->string;
933
$self->log_dns_result ("A for NS $hname: $str");
1021
if (!defined $hname) {
1022
warn "complete_a_lookup-1: $j, (hname is undef), $str";
1023
} elsif (!defined $str) {
1024
warn "complete_a_lookup-2: $j, $hname, (str is undef)";
1027
dbg("uridnsbl: complete_a_lookup got(%d) A for %s: %s", $j,$hname,$str);
935
1030
if ($str =~ /IN\s+A\s+(\S+)/) {
936
$self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $1);
1031
$self->lookup_dnsbl_for_ip($pms, $ent->{obj}, $1);
941
1036
# ---------------------------------------------------------------------------
943
1038
sub lookup_dnsbl_for_ip {
944
my ($self, $scanner, $obj, $ip) = @_;
1039
my ($self, $pms, $obj, $ip) = @_;
946
1041
local($1,$2,$3,$4);
947
1042
$ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
948
1043
my $revip = "$4.$3.$2.$1";
950
my $tflags = $scanner->{conf}->{tflags};
951
my $cf = $scanner->{uridnsbl_active_rules_revipbl};
952
foreach my $rulename (keys %{$cf}) {
953
my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
1045
my $conf = $pms->{conf};
1046
my $tflags = $conf->{tflags};
1047
my $cfns = $pms->{uridnsbl_active_rules_nsrevipbl};
1048
my $cfa = $pms->{uridnsbl_active_rules_arevipbl};
1049
foreach my $rulename (keys %$cfa, keys %$cfns) {
1050
my $rulecf = $conf->{uridnsbls}->{$rulename};
955
1052
# ips_only/domains_only lookups should not act on this kind of BL
956
next if ($tflags->{$rulename} =~ /\b(?:ips_only|domains_only)\b/);
958
$self->lookup_single_dnsbl($scanner, $obj, $rulename,
1053
next if defined $tflags->{$rulename} &&
1054
$tflags->{$rulename} =~ /\b(?:ips_only|domains_only)\b/;
1056
$self->lookup_single_dnsbl($pms, $obj, $rulename,
959
1057
$revip, $rulecf->{zone}, $rulecf->{type});
963
1061
sub lookup_single_dnsbl {
964
my ($self, $scanner, $obj, $rulename, $lookupstr, $dnsbl, $qtype) = @_;
966
my $key = "DNSBL:".$dnsbl.":".$lookupstr;
967
return if $scanner->{async}->get_lookup($key);
968
my $item = $lookupstr.".".$dnsbl;
971
my $ent = $self->start_lookup($scanner, $item, 'DNSBL',
972
$self->res_bgsend($scanner, $item, $qtype, $key),
975
$ent->{rulename} = $rulename;
976
$ent->{zone} = $dnsbl;
1062
my ($self, $pms, $obj, $rulename, $lookupstr, $dnsbl, $qtype) = @_;
1064
my $key = "DNSBL:" . $lookupstr . ':' . $dnsbl;
1066
key => $key, zone => $dnsbl, obj => $obj, type => 'URI-DNSBL',
1067
rulename => $rulename,
1069
$ent = $pms->{async}->bgsend_and_start_lookup(
1070
$lookupstr.".".$dnsbl, $qtype, undef, $ent,
1071
sub { my ($ent2,$pkt) = @_;
1072
$self->complete_dnsbl_lookup($pms, $ent2, $pkt) },
1073
master_deadline => $pms->{master_deadline} );
979
1078
sub complete_dnsbl_lookup {
980
my ($self, $scanner, $ent, $dnsblip) = @_;
982
my $conf = $scanner->{conf};
1079
my ($self, $pms, $ent, $pkt) = @_;
1082
# $pkt will be undef if the DNS query was aborted (e.g. timed out)
1083
dbg("uridnsbl: complete_dnsbl_lookup aborted %s %s",
1084
$ent->{rulename}, $ent->{key});
1088
dbg("uridnsbl: complete_dnsbl_lookup %s %s", $ent->{rulename}, $ent->{key});
1089
my $conf = $pms->{conf};
1091
my $zone = $ent->{zone};
1092
my $dom = $ent->{obj}->{dom};
984
1093
my $rulename = $ent->{rulename};
985
1094
my $rulecf = $conf->{uridnsbls}->{$rulename};
987
my $packet = $ent->{response_packet};
988
my @answer = !defined $packet ? () : $packet->answer;
990
my $uridnsbl_subs = $conf->{uridnsbl_subs}->{$ent->{zone}};
1097
my @answer = $pkt->answer;
991
1098
foreach my $rr (@answer)
993
next if ($rr->type ne 'A' && $rr->type ne 'TXT');
1100
my($rdatastr,$rdatanum);
1101
my $rr_type = $rr->type;
995
my $dom = $ent->{obj}->{dom};
996
my $rdatastr = $rr->rdatastr;
998
if ($rdatastr =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
999
$rdatanum = Mail::SpamAssassin::Util::my_inet_aton($rdatastr);
1103
if ($rr_type eq 'A') {
1104
$rdatastr = $rr->rdatastr;
1105
if ($rdatastr =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
1106
$rdatanum = Mail::SpamAssassin::Util::my_inet_aton($rdatastr);
1108
} elsif ($rr_type eq 'TXT') {
1109
# txtdata returns a non- zone-file-format encoded result, unlike rdatastr;
1110
# avoid space-separated RDATA <character-string> fields if possible;
1111
# txtdata provides a list of strings in list context since Net::DNS 0.69
1112
$rdatastr = join('',$rr->txtdata);
1002
if (!$rulecf->{is_subrule}) {
1117
my $subtest = $rulecf->{subtest};
1119
dbg("uridnsbl: %s . %s -> %s, %s%s",
1120
$dom, $zone, $rdatastr, $rulename,
1121
!defined $subtest ? '' : ', subtest:'.$subtest);
1124
if (!defined $subtest) {
1003
1125
# this zone is a simple rule, not a set of subrules
1004
1126
# skip any A record that isn't on 127/8
1005
if ($rr->type eq 'A' && $rr->rdatastr !~ /^127\./) {
1127
if ($rr_type eq 'A' && $rdatastr !~ /^127\./) {
1006
1128
warn("uridnsbl: bogus rr for domain=$dom, rule=$rulename, id=" .
1007
$packet->header->id." rr=".$rr->string);
1129
$pkt->header->id." rr=".$rr->string);
1010
$self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $rulename);
1014
foreach my $subtest (keys (%{$uridnsbl_subs})) {
1016
if ($subtest eq $rdatastr) {
1018
} elsif ($subtest =~ m{^ (\d+) (?: ([/-]) (\d+) )? \z}x) {
1019
my($n1,$delim,$n2) = ($1,$2,$3);
1021
!defined $n2 ? $rdatanum & $n1 # mask only
1022
: $delim eq '-' ? $rdatanum >= $n1 && $rdatanum <= $n2 # range
1023
: $delim eq '/' ? ($rdatanum & $n2) == ($n1 & $n2) # value/mask
1025
# dbg("uridnsbl: %s %s/%s/%s, %s, %s", $match?'Y':'N', $dom, $rulename,
1026
# join('.',@{$uridnsbl_subs->{$subtest}->{rulenames}}),
1027
# $rdatanum, !defined $n2 ? $n1 : "$n1 $delim $n2");
1030
foreach my $subrulename (@{$uridnsbl_subs->{$subtest}->{rulenames}}) {
1031
$self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $subrulename);
1133
} elsif ($subtest eq $rdatastr) {
1135
} elsif ($subtest =~ m{^ (\d+) (?: ([/-]) (\d+) )? \z}x) {
1136
my($n1,$delim,$n2) = ($1,$2,$3);
1138
!defined $n2 ? ($rdatanum & $n1) && # mask only
1139
(($rdatanum & 0xff000000) == 0x7f000000) # 127/8
1140
: $delim eq '-' ? $rdatanum >= $n1 && $rdatanum <= $n2 # range
1141
: $delim eq '/' ? ($rdatanum & $n2) == ($n1 & $n2) # value/mask
1144
dbg("uridnsbl: %s . %s -> %s, %s, %08x %s %s",
1145
$dom, $zone, $rdatastr, $rulename, $rdatanum,
1146
!defined $n2 ? sprintf('& %08x', $n1)
1147
: $n1 == $n2 ? sprintf('== %08x', $n1)
1148
: sprintf('%08x%s%08x', $n1,$delim,$n2),
1149
$match ? 'match' : 'no');
1151
$self->got_dnsbl_hit($pms, $ent, $rdatastr, $dom, $rulename) if $match;
1039
1155
sub got_dnsbl_hit {
1040
my ($self, $scanner, $ent, $str, $dom, $rulename) = @_;
1156
my ($self, $pms, $ent, $str, $dom, $rulename) = @_;
1042
1158
$str =~ s/\s+/ /gs; # long whitespace => short
1043
1159
dbg("uridnsbl: domain \"$dom\" listed ($rulename): $str");
1045
if (!defined $scanner->{uridnsbl_hits}->{$rulename}) {
1046
$scanner->{uridnsbl_hits}->{$rulename} = { };
1161
if (!defined $pms->{uridnsbl_hits}->{$rulename}) {
1162
$pms->{uridnsbl_hits}->{$rulename} = { };
1048
$scanner->{uridnsbl_hits}->{$rulename}->{$dom} = 1;
1164
$pms->{uridnsbl_hits}->{$rulename}->{$dom} = 1;
1050
if ($scanner->{uridnsbl_active_rules_revipbl}->{$rulename}
1051
|| $scanner->{uridnsbl_active_rules_nsrhsbl}->{$rulename}
1052
|| $scanner->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename}
1053
|| $scanner->{uridnsbl_active_rules_rhsbl}->{$rulename}
1054
|| $scanner->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename}
1055
|| $scanner->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename})
1166
if ( $pms->{uridnsbl_active_rules_nsrevipbl}->{$rulename}
1167
|| $pms->{uridnsbl_active_rules_arevipbl}->{$rulename}
1168
|| $pms->{uridnsbl_active_rules_nsrhsbl}->{$rulename}
1169
|| $pms->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename}
1170
|| $pms->{uridnsbl_active_rules_rhsbl}->{$rulename}
1171
|| $pms->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename}
1172
|| $pms->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename})
1057
1174
# TODO: this needs to handle multiple domain hits per rule
1058
$scanner->clear_test_state();
1059
my $uris = join (' ', keys %{$scanner->{uridnsbl_hits}->{$rulename}});
1060
$scanner->test_log ("URIs: $uris");
1061
$scanner->got_hit ($rulename, "");
1175
$pms->clear_test_state();
1176
my $uris = join (' ', keys %{$pms->{uridnsbl_hits}->{$rulename}});
1177
$pms->test_log ("URIs: $uris");
1178
$pms->got_hit ($rulename, "");
1063
1180
# note that this rule has completed (since it got at least 1 hit)
1064
$scanner->register_async_rule_finish($rulename);
1068
# ---------------------------------------------------------------------------
1071
my ($self, $scanner, $zone, $type, $id, $key) = @_;
1075
zone => $zone, # serves to fetch other per-zone settings
1076
type => "URI-".$type,
1078
completed_callback => sub {
1080
if (defined $ent->{response_packet}) { # not aborted or empty
1081
$self->completed_lookup_callback ($scanner, $ent);
1085
$scanner->{async}->start_lookup($ent, $scanner->{master_deadline});
1089
sub completed_lookup_callback {
1090
my ($self, $scanner, $ent) = @_;
1091
my $type = $ent->{type};
1092
my $key = $ent->{key};
1093
$key =~ /:(\S+?)$/; my $val = $1;
1095
if ($type eq 'URI-NS') {
1096
$self->complete_ns_lookup ($scanner, $ent, $val);
1098
elsif ($type eq 'URI-A') {
1099
$self->complete_a_lookup ($scanner, $ent, $val);
1101
elsif ($type eq 'URI-DNSBL') {
1102
$self->complete_dnsbl_lookup ($scanner, $ent, $val);
1106
# ---------------------------------------------------------------------------
1109
my ($self, $scanner, $host, $type, $key) = @_;
1111
return $self->{main}->{resolver}->bgsend($host, $type, undef, sub {
1112
my ($pkt, $id, $timestamp) = @_;
1113
$scanner->{async}->set_response_packet($id, $pkt, $key, $timestamp);
1117
sub log_dns_result {
1119
#Mail::SpamAssassin::dbg("uridnsbl: ".join (' ', @_));
1181
$pms->register_async_rule_finish($rulename);
1122
1185
# ---------------------------------------------------------------------------
added
removed
lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm
