Author: julian
Date: 2005-12-15 20:19:40 -0600 (Thu, 15 Dec 2005)
New Revision: 118
Added:
trunk/t/00_all.t
Removed:
trunk/t/00all.t
Modified:
trunk/Query.pm
Log:
trunk/Query.pm
* Restrict number of SPF record lookups to a maximum of 10 (was: 20).
* mech_a(), mech_mx(): Check if domain is a valid FQDN, i.e. ends in
("." toplabel).
* mech_ip4():
* Return "unknown" (PermError) if no argument was given to ip4 mechanism.
* Don't auto-complete "1.2.3" CIDR specs to "1.2.3.0" as such an abbreviated
syntax isn't allowed by the SPF spec in the first place.
(Thanks to Craig Whitmore for pointing out the above issues!)
* Removed recursion depth counting, it was redundant to lookup counting.
* Explicitly initialize lookup count to 0 in new().
* Removed unused global "$softfail_supported" flag.
* Minor code and comment clean-ups.
trunk/t/00all.t
trunk/t/00_all.t
* Renamed 00all.t to 00_all.t.
Modified: trunk/Query.pm
===================================================================
--- trunk/Query.pm 2005-12-07 23:48:47 UTC (rev 117)
+++ trunk/Query.pm 2005-12-16 02:19:40 UTC (rev 118)
@@ -49,26 +49,22 @@
use URI::Escape;
use Net::CIDR::Lite;
-use Net::DNS qw(); # by default it exports mx, which we define.
+use Net::DNS qw(); # by default it exports mx, which we define.
# ----------------------------------------------------------
# initialization
# ----------------------------------------------------------
-my $GUESS_MECHS = "a/24 mx/24 ptr";
+my $GUESS_MECHS = "a/24 mx/24 ptr";
+my $TRUSTED_FORWARDER = "include:spf.trusted-forwarder.org";
-my $TRUSTED_FORWARDER = "include:spf.trusted-forwarder.org";
-
my $DEFAULT_EXPLANATION = "Please see http://www.openspf.org/why.html?sender=%{S}&ip=%{I}&receiver=%{R}";
-my @KNOWN_MECHANISMS = qw( a mx ptr include ip4 ip6 exists all );
-my $MAX_LOOKUP_COUNT = 20;
+my @KNOWN_MECHANISMS = qw( a mx ptr include ip4 ip6 exists all );
+my $MAX_LOOKUP_COUNT = 10;
-my $Domains_Queried = {};
+my $Domains_Queried = {};
-# if not set, then softfail is treated as neutral.
-my $softfail_supported = 1;
-
-our $CACHE_TIMEOUT = 120;
+our $CACHE_TIMEOUT = 120;
our $DNS_RESOLVER_TIMEOUT = 15;
# ----------------------------------------------------------
@@ -157,7 +153,7 @@
trusted => 1, # do trusted forwarder processing
guess => 1, # do best_guess if no SPF record
default_explanation => 'Please see http://spf.my.isp/spferror.html for details',
- max_lookup_count => 20, # total number of SPF include/redirect queries
+ max_lookup_count => 10, # total number of SPF include/redirect queries
sanitize => 0, # do not sanitize all returned strings
myhostname => "foo.example.com", # prepended to header_comment
fallback => { "foo.com" => { record => "v=spf1 a mx -all", OPTION => VALUE },
@@ -215,10 +211,10 @@
sub new {
# ----------------------------------------------------------
my $class = shift;
- my $query = bless { depth => 0,
- @_,
- }, $class;
+ my $query = bless { @_ }, $class;
+ $query->{lookup_count} = 0;
+
$query->{ipv4} = delete $query->{ip} if $query->{ip} and $query->{ip} =~ $looks_like_ipv4;
$query->{helo} = delete $query->{ehlo} if $query->{ehlo};
@@ -239,7 +235,9 @@
$query->{sender} =~ s/<(.*)>/$1/g;
- if (not ($query->{ipv4} and length $query->{ipv4})) { die "no IP address given to spfquery" }
+ if (not ($query->{ipv4} and length $query->{ipv4})) {
+ die "no IP address given";
+ }
for ($query->{sender}) { s/^\s+//; s/\s+$//; }
@@ -262,7 +260,7 @@
($query->{helo}) =~ s/.*\@//; # strip localpart from helo
if (not $query->{domain}) {
- $query->debuglog("spfquery: sender $query->{sender} has no domain, using HELO domain $query->{helo} instead.");
+ $query->debuglog("sender $query->{sender} has no domain, using HELO domain $query->{helo} instead.");
$query->{domain} = $query->{helo};
$query->{sender} = $query->{helo};
}
@@ -394,7 +392,9 @@
my $query = shift;
my %result_set;
- my ($result, $smtp_explanation, $smtp_why, $orig_txt) = $query->spfquery( ($query->{best_guess} ? $query->{guess_mechs} : () ) );
+ my ($result, $smtp_explanation, $smtp_why, $orig_txt) = $query->spfquery(
+ $query->{best_guess} ? $query->{guess_mechs} : ()
+ );
$smtp_why = "" if $smtp_why eq "default";
@@ -739,7 +739,6 @@
reason => "has no data. best guess",
);
- $guess_query->{depth} = 0;
$guess_query->top->{lookup_count} = 0;
# if result is not defined, the domain has no SPF.
@@ -824,19 +823,23 @@
=cut
sub debuglog {
- my $self = shift;
- return if ref $self and not $self->{debug};
+ my $query = shift;
+ return if ref $query and not $query->{debug};
my $toprint = join (" ", @_);
chomp $toprint;
$toprint = sprintf ("%-8s %s %s %s",
- ("|" x ($self->{depth}+1)),
- $self->{localpart},
- $self->{domain},
+ ("|" x ($query->top->{lookup_count}+1)),
+ $query->{localpart},
+ $query->{domain},
$toprint);
- if (exists $self->{debuglog} and ref $self->{debuglog} eq "CODE") { eval { $self->{debuglog}->($toprint) } ; }
- else { printf STDERR "%s", "$toprint\n"; }
+ if (exists $query->{debuglog} and ref $query->{debuglog} eq "CODE") {
+ eval { $query->{debuglog}->($toprint) };
+ }
+ else {
+ printf STDERR "%s", "$toprint\n";
+ }
}
# ----------------------------------------------------------
@@ -919,7 +922,6 @@
$query->debuglog(" executing redirect=$new_domain");
my $inner_query = $query->clone(domain => $new_domain,
- depth => $query->{depth} + 1,
reason => "redirects to $new_domain",
);
@@ -959,17 +961,13 @@
sub is_looping {
my $query = shift;
my $cache_point = $query->cache_point;
- return (join " ", "loop encountered:", @{$query->{loop_report}})
- if (exists $Domains_Queried->{$cache_point}
- and
- not defined $Domains_Queried->{$cache_point}->[0]);
- return (join " ", "exceeded maximum recursion depth:", @{$query->{loop_report}})
- if ($query->{depth} >= $query->max_lookup_count);
+ return join(" ", "loop encountered:", @{$query->{loop_report}})
+ if exists $Domains_Queried->{$cache_point}
+ and not defined $Domains_Queried->{$cache_point}->[0];
- return ("query caused more than " . $query->max_lookup_count . " lookups") if ($query->max_lookup_count
- and
- $query->top->{lookup_count} > $query->max_lookup_count);
+ return join(" ", "query caused more than" . $query->max_lookup_count . " lookups:", @{$query->{loop_report}})
+ if $query->max_lookup_count and $query->top->{lookup_count} > $query->max_lookup_count;
return 0;
}
@@ -1262,16 +1260,11 @@
#
# Mechanisms return one of the following:
#
-# hit
-# mechanism matched
-# undef
-# mechanism did not match
+# undef mechanism did not match
+# "hit" mechanism matched
+# "unknown" some error happened during processing
+# "error" some temporary error
#
-# unknown
-# some error happened during processing
-# error
-# some temporary error
-#
# ----------------------------------------------------------
# all
# ----------------------------------------------------------
@@ -1297,7 +1290,6 @@
$query->debuglog(" mechanism include: recursing into $argument");
my $inner_query = $query->clone(domain => $argument,
- depth => $query->{depth} + 1,
reason => "includes $argument",
local => undef,
trusted => undef,
@@ -1334,7 +1326,11 @@
my $domain_to_use = $argument || $query->{domain};
- # see code below in ip4
+ # see code below in ip4 for more validation
+ if ($domain_to_use !~ / \. \p{IsAlpha} (?: [\p{IsAlnum}-]* \p{IsAlnum} ) $ /x) {
+ return ("unknown" => "bad argument to a: $domain_to_use not a valid FQDN");
+ }
+
foreach my $a ($query->myquery($domain_to_use, "A", "address")) {
$query->debuglog(" mechanism a: $a");
if ($a eq $query->{ipv4}) {
@@ -1366,14 +1362,12 @@
my $domain_to_use = $argument || $query->{domain};
+ if ($domain_to_use !~ / \. \p{IsAlpha} (?: [\p{IsAlnum}-]* \p{IsAlnum} ) $ /x) {
+ return ("unknown" => "bad argument to mx: $domain_to_use not a valid FQDN");
+ }
+
my @mxes = $query->myquery($domain_to_use, "MX", "exchange", "preference");
- # if a domain has no MX record, we MUST NOT use its IP address instead.
- # if (! @mxes) {
- # $query->debuglog(" mechanism mx: no MX found for $domain_to_use. Will pretend it is its own MX, and test its IP address.");
- # @mxes = ($domain_to_use);
- # }
-
foreach my $mx (@mxes) {
# $query->debuglog(" mechanism mx: $mx");
@@ -1469,22 +1463,18 @@
my $query = shift;
my $cidr_spec = shift;
- return if not length $cidr_spec;
+ if ($cidr_spec eq '') {
+ return ("unknown" => "no argument given to ip4");
+ }
my ($network, $cidr_length) = split (/\//, $cidr_spec, 2);
- my $dot_count = $network =~ tr/././;
-
- # turn "1.2.3/24" into "1.2.3.0/24"
- for (1 .. (3 - $dot_count)) { $network .= ".0"; }
-
- # TODO: add library compatibility test for ill-formed ip4 syntax
if ($network !~ /^\d+\.\d+\.\d+\.\d+$/) { return ("unknown" => "bad argument to ip4: $cidr_spec"); }
$cidr_length = "32" if not defined $cidr_length;
local $@;
- my $cidr = eval { Net::CIDR::Lite->new("$network/$cidr_length") }; # TODO: make this work for ipv6 as well
+ my $cidr = eval { Net::CIDR::Lite->new("$network/$cidr_length") };
if ($@) { return ("unknown" => "unable to parse ip4:$cidr_spec"); }
$query->debuglog(" mechanism ip4: looking for $query->{ipv4} in $cidr_spec");
@@ -1664,7 +1654,7 @@
}
}
- # squish multiline responses into one first.
+ # Combine multiple TXT strings into a single string:
foreach (@txt) {
s/^"(.*)"$/$1/;
s/^\s+//;
@@ -1788,10 +1778,10 @@
Mail::Query::SPF should only be used at the point where messages are received
from the Internet. The underlying assumption is that the sender of the e-mail
-is sending the message directly to you or one of your secondary MXes. If your
+is sending the message directly to you or one of your secondary MXes. If your
MTA does not have an exhaustive list of secondary MXes, then the C<result2()>
-and C<message_result2()> methods can be used. These methods take care to permit
-mail from secondary MXes.
+and C<message_result2()> methods can be used. These methods take care to
+permit mail from secondary MXes.
=head1 AUTHORS
Copied: trunk/t/00_all.t (from rev 116, trunk/t/00all.t)
Deleted: trunk/t/00all.t
===================================================================
--- trunk/t/00all.t 2005-12-07 23:48:47 UTC (rev 117)
+++ trunk/t/00all.t 2005-12-16 02:19:40 UTC (rev 118)
@@ -1,142 +0,0 @@
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl t/00all.t'
-
-#########################
-
-use Test;
-use strict;
-use Getopt::Std;
-
-my %opts;
-
-getopts('d:',\%opts);
-
-my @test_table;
-
-BEGIN {
- open TESTFILE, "test.txt";
- @test_table = grep { /\S/ and not /^\s*#/ } <TESTFILE>;
- chomp @test_table;
- close TESTFILE;
-
- plan tests => 1 + map(/\G,?(\d+)/g, @test_table);
-};
-
-use Mail::SPF::Query;
-
-# 1: did the library load okay?
-ok(1);
-
-if ($opts{d}) {
- open(TEST, ">$opts{d}") || die "Cannot open $opts{d} for output";
-}
-
-my $testnum = 2;
-
-#########################
-
-foreach my $tuple (@test_table) {
- my ($num, $domain, $ipv4, $expected_result, $expected_smtp_comment, $expected_header_comment) =
- ($tuple =~ /\t/ ? split(/\t/, $tuple) : split(' ', $tuple));
-
- my ($actual_result, $actual_smtp_comment, $actual_header_comment);
-
- my ($sender, $localpolicy) = split(':', $domain, 2);
- $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge;
- $domain = $sender;
- if ($domain =~ /\@/) { ($domain) = $domain =~ /\@(.+)/ }
-
- my $testcnt = 3;
-
- if ($expected_result =~ /=(pass|fail),/) {
- for (my $debug = 0; $debug < 2; $debug++) {
- Mail::SPF::Query->clear_cache;
- my $query = eval { new Mail::SPF::Query (ipv4 => $ipv4,
- sender => $sender,
- helo => $domain,
- debug => $debug,
- local => $localpolicy,
- ); };
-
- my $ok = 1;
- my $header_comment;
-
- $actual_result = "";
-
- foreach my $e_result (split(/,/, $expected_result)) {
- if ($e_result !~ /=/) {
- my ($msg_result, $smtp_comment);
- ($msg_result, $smtp_comment, $header_comment) = eval { $query->message_result2 };
-
- $actual_result .= $msg_result;
-
- $ok = ok($msg_result, $e_result) if (!$debug);
- if (!$ok) {
- last;
- }
- } else {
- my ($recip, $expected_recip_result) = split(/=/, $e_result, 2);
- my ($recip_result, $smtp_comment) = eval { $query->result2(split(';',$recip)) };
-
- $actual_result .= "$recip=$recip_result,";
- $testcnt++;
-
- $ok = ok($recip_result, $expected_recip_result) if (!$debug);
- if (!$ok) {
- last;
- }
- }
- }
-
- $header_comment =~ s/\S+: //; # strip the reporting hostname prefix
-
- if ($expected_header_comment) {
- $ok &= ok($header_comment, $expected_header_comment) if (!$debug);
- }
- $actual_header_comment = $header_comment;
- $actual_smtp_comment = '.';
- last if ($ok);
- }
- } else {
- my ($result, $smtp_comment, $header_comment) = eval { new Mail::SPF::Query (ipv4 => $ipv4,
- sender => $sender,
- helo => $domain,
- local => $localpolicy,
- default_explanation => "explanation",
- )->result; };
- $header_comment =~ s/^\S+: //; # strip the reporting hostname prefix
-
- my $ok = (! $expected_smtp_comment
- ? ok($result, $expected_result)
- : (ok($result, $expected_result) &&
- ok($smtp_comment, $expected_smtp_comment) &&
- ok($header_comment, $expected_header_comment)));
-
- $actual_smtp_comment = $smtp_comment;
- $actual_result = $result;
- $actual_header_comment = $header_comment;
-
- if (not $ok) {
- Mail::SPF::Query->clear_cache;
- my $result = eval { scalar(new Mail::SPF::Query (ipv4 => $ipv4,
- sender => $sender,
- helo => $domain,
- debug => 1,
- local => $localpolicy,
- )->result) };
- if ($@) {
- print " trapped error: $@\n";
- next;
- }
- }
- }
- if ($opts{d}) {
- $num = join(",", $testnum .. $testnum + $testcnt - 1);
- $testnum += $testcnt;
- print TEST join("\t", $num, $sender . ($localpolicy ? ":$localpolicy": ""), $ipv4, $actual_result, $actual_smtp_comment, $actual_header_comment),
- "\n";
- }
-}
-
-# vim:syn=perl
-------
To unsubscribe, change your address, or temporarily deactivate your subscription,
please go to http://v2.listbox.com/member/?listname=spf-devel@v2.listbox.com
Date: 2005-12-15 20:19:40 -0600 (Thu, 15 Dec 2005)
New Revision: 118
Added:
trunk/t/00_all.t
Removed:
trunk/t/00all.t
Modified:
trunk/Query.pm
Log:
trunk/Query.pm
* Restrict number of SPF record lookups to a maximum of 10 (was: 20).
* mech_a(), mech_mx(): Check if domain is a valid FQDN, i.e. ends in
("." toplabel).
* mech_ip4():
* Return "unknown" (PermError) if no argument was given to ip4 mechanism.
* Don't auto-complete "1.2.3" CIDR specs to "1.2.3.0" as such an abbreviated
syntax isn't allowed by the SPF spec in the first place.
(Thanks to Craig Whitmore for pointing out the above issues!)
* Removed recursion depth counting, it was redundant to lookup counting.
* Explicitly initialize lookup count to 0 in new().
* Removed unused global "$softfail_supported" flag.
* Minor code and comment clean-ups.
trunk/t/00all.t
trunk/t/00_all.t
* Renamed 00all.t to 00_all.t.
Modified: trunk/Query.pm
===================================================================
--- trunk/Query.pm 2005-12-07 23:48:47 UTC (rev 117)
+++ trunk/Query.pm 2005-12-16 02:19:40 UTC (rev 118)
@@ -49,26 +49,22 @@
use URI::Escape;
use Net::CIDR::Lite;
-use Net::DNS qw(); # by default it exports mx, which we define.
+use Net::DNS qw(); # by default it exports mx, which we define.
# ----------------------------------------------------------
# initialization
# ----------------------------------------------------------
-my $GUESS_MECHS = "a/24 mx/24 ptr";
+my $GUESS_MECHS = "a/24 mx/24 ptr";
+my $TRUSTED_FORWARDER = "include:spf.trusted-forwarder.org";
-my $TRUSTED_FORWARDER = "include:spf.trusted-forwarder.org";
-
my $DEFAULT_EXPLANATION = "Please see http://www.openspf.org/why.html?sender=%{S}&ip=%{I}&receiver=%{R}";
-my @KNOWN_MECHANISMS = qw( a mx ptr include ip4 ip6 exists all );
-my $MAX_LOOKUP_COUNT = 20;
+my @KNOWN_MECHANISMS = qw( a mx ptr include ip4 ip6 exists all );
+my $MAX_LOOKUP_COUNT = 10;
-my $Domains_Queried = {};
+my $Domains_Queried = {};
-# if not set, then softfail is treated as neutral.
-my $softfail_supported = 1;
-
-our $CACHE_TIMEOUT = 120;
+our $CACHE_TIMEOUT = 120;
our $DNS_RESOLVER_TIMEOUT = 15;
# ----------------------------------------------------------
@@ -157,7 +153,7 @@
trusted => 1, # do trusted forwarder processing
guess => 1, # do best_guess if no SPF record
default_explanation => 'Please see http://spf.my.isp/spferror.html for details',
- max_lookup_count => 20, # total number of SPF include/redirect queries
+ max_lookup_count => 10, # total number of SPF include/redirect queries
sanitize => 0, # do not sanitize all returned strings
myhostname => "foo.example.com", # prepended to header_comment
fallback => { "foo.com" => { record => "v=spf1 a mx -all", OPTION => VALUE },
@@ -215,10 +211,10 @@
sub new {
# ----------------------------------------------------------
my $class = shift;
- my $query = bless { depth => 0,
- @_,
- }, $class;
+ my $query = bless { @_ }, $class;
+ $query->{lookup_count} = 0;
+
$query->{ipv4} = delete $query->{ip} if $query->{ip} and $query->{ip} =~ $looks_like_ipv4;
$query->{helo} = delete $query->{ehlo} if $query->{ehlo};
@@ -239,7 +235,9 @@
$query->{sender} =~ s/<(.*)>/$1/g;
- if (not ($query->{ipv4} and length $query->{ipv4})) { die "no IP address given to spfquery" }
+ if (not ($query->{ipv4} and length $query->{ipv4})) {
+ die "no IP address given";
+ }
for ($query->{sender}) { s/^\s+//; s/\s+$//; }
@@ -262,7 +260,7 @@
($query->{helo}) =~ s/.*\@//; # strip localpart from helo
if (not $query->{domain}) {
- $query->debuglog("spfquery: sender $query->{sender} has no domain, using HELO domain $query->{helo} instead.");
+ $query->debuglog("sender $query->{sender} has no domain, using HELO domain $query->{helo} instead.");
$query->{domain} = $query->{helo};
$query->{sender} = $query->{helo};
}
@@ -394,7 +392,9 @@
my $query = shift;
my %result_set;
- my ($result, $smtp_explanation, $smtp_why, $orig_txt) = $query->spfquery( ($query->{best_guess} ? $query->{guess_mechs} : () ) );
+ my ($result, $smtp_explanation, $smtp_why, $orig_txt) = $query->spfquery(
+ $query->{best_guess} ? $query->{guess_mechs} : ()
+ );
$smtp_why = "" if $smtp_why eq "default";
@@ -739,7 +739,6 @@
reason => "has no data. best guess",
);
- $guess_query->{depth} = 0;
$guess_query->top->{lookup_count} = 0;
# if result is not defined, the domain has no SPF.
@@ -824,19 +823,23 @@
=cut
sub debuglog {
- my $self = shift;
- return if ref $self and not $self->{debug};
+ my $query = shift;
+ return if ref $query and not $query->{debug};
my $toprint = join (" ", @_);
chomp $toprint;
$toprint = sprintf ("%-8s %s %s %s",
- ("|" x ($self->{depth}+1)),
- $self->{localpart},
- $self->{domain},
+ ("|" x ($query->top->{lookup_count}+1)),
+ $query->{localpart},
+ $query->{domain},
$toprint);
- if (exists $self->{debuglog} and ref $self->{debuglog} eq "CODE") { eval { $self->{debuglog}->($toprint) } ; }
- else { printf STDERR "%s", "$toprint\n"; }
+ if (exists $query->{debuglog} and ref $query->{debuglog} eq "CODE") {
+ eval { $query->{debuglog}->($toprint) };
+ }
+ else {
+ printf STDERR "%s", "$toprint\n";
+ }
}
# ----------------------------------------------------------
@@ -919,7 +922,6 @@
$query->debuglog(" executing redirect=$new_domain");
my $inner_query = $query->clone(domain => $new_domain,
- depth => $query->{depth} + 1,
reason => "redirects to $new_domain",
);
@@ -959,17 +961,13 @@
sub is_looping {
my $query = shift;
my $cache_point = $query->cache_point;
- return (join " ", "loop encountered:", @{$query->{loop_report}})
- if (exists $Domains_Queried->{$cache_point}
- and
- not defined $Domains_Queried->{$cache_point}->[0]);
- return (join " ", "exceeded maximum recursion depth:", @{$query->{loop_report}})
- if ($query->{depth} >= $query->max_lookup_count);
+ return join(" ", "loop encountered:", @{$query->{loop_report}})
+ if exists $Domains_Queried->{$cache_point}
+ and not defined $Domains_Queried->{$cache_point}->[0];
- return ("query caused more than " . $query->max_lookup_count . " lookups") if ($query->max_lookup_count
- and
- $query->top->{lookup_count} > $query->max_lookup_count);
+ return join(" ", "query caused more than" . $query->max_lookup_count . " lookups:", @{$query->{loop_report}})
+ if $query->max_lookup_count and $query->top->{lookup_count} > $query->max_lookup_count;
return 0;
}
@@ -1262,16 +1260,11 @@
#
# Mechanisms return one of the following:
#
-# hit
-# mechanism matched
-# undef
-# mechanism did not match
+# undef mechanism did not match
+# "hit" mechanism matched
+# "unknown" some error happened during processing
+# "error" some temporary error
#
-# unknown
-# some error happened during processing
-# error
-# some temporary error
-#
# ----------------------------------------------------------
# all
# ----------------------------------------------------------
@@ -1297,7 +1290,6 @@
$query->debuglog(" mechanism include: recursing into $argument");
my $inner_query = $query->clone(domain => $argument,
- depth => $query->{depth} + 1,
reason => "includes $argument",
local => undef,
trusted => undef,
@@ -1334,7 +1326,11 @@
my $domain_to_use = $argument || $query->{domain};
- # see code below in ip4
+ # see code below in ip4 for more validation
+ if ($domain_to_use !~ / \. \p{IsAlpha} (?: [\p{IsAlnum}-]* \p{IsAlnum} ) $ /x) {
+ return ("unknown" => "bad argument to a: $domain_to_use not a valid FQDN");
+ }
+
foreach my $a ($query->myquery($domain_to_use, "A", "address")) {
$query->debuglog(" mechanism a: $a");
if ($a eq $query->{ipv4}) {
@@ -1366,14 +1362,12 @@
my $domain_to_use = $argument || $query->{domain};
+ if ($domain_to_use !~ / \. \p{IsAlpha} (?: [\p{IsAlnum}-]* \p{IsAlnum} ) $ /x) {
+ return ("unknown" => "bad argument to mx: $domain_to_use not a valid FQDN");
+ }
+
my @mxes = $query->myquery($domain_to_use, "MX", "exchange", "preference");
- # if a domain has no MX record, we MUST NOT use its IP address instead.
- # if (! @mxes) {
- # $query->debuglog(" mechanism mx: no MX found for $domain_to_use. Will pretend it is its own MX, and test its IP address.");
- # @mxes = ($domain_to_use);
- # }
-
foreach my $mx (@mxes) {
# $query->debuglog(" mechanism mx: $mx");
@@ -1469,22 +1463,18 @@
my $query = shift;
my $cidr_spec = shift;
- return if not length $cidr_spec;
+ if ($cidr_spec eq '') {
+ return ("unknown" => "no argument given to ip4");
+ }
my ($network, $cidr_length) = split (/\//, $cidr_spec, 2);
- my $dot_count = $network =~ tr/././;
-
- # turn "1.2.3/24" into "1.2.3.0/24"
- for (1 .. (3 - $dot_count)) { $network .= ".0"; }
-
- # TODO: add library compatibility test for ill-formed ip4 syntax
if ($network !~ /^\d+\.\d+\.\d+\.\d+$/) { return ("unknown" => "bad argument to ip4: $cidr_spec"); }
$cidr_length = "32" if not defined $cidr_length;
local $@;
- my $cidr = eval { Net::CIDR::Lite->new("$network/$cidr_length") }; # TODO: make this work for ipv6 as well
+ my $cidr = eval { Net::CIDR::Lite->new("$network/$cidr_length") };
if ($@) { return ("unknown" => "unable to parse ip4:$cidr_spec"); }
$query->debuglog(" mechanism ip4: looking for $query->{ipv4} in $cidr_spec");
@@ -1664,7 +1654,7 @@
}
}
- # squish multiline responses into one first.
+ # Combine multiple TXT strings into a single string:
foreach (@txt) {
s/^"(.*)"$/$1/;
s/^\s+//;
@@ -1788,10 +1778,10 @@
Mail::Query::SPF should only be used at the point where messages are received
from the Internet. The underlying assumption is that the sender of the e-mail
-is sending the message directly to you or one of your secondary MXes. If your
+is sending the message directly to you or one of your secondary MXes. If your
MTA does not have an exhaustive list of secondary MXes, then the C<result2()>
-and C<message_result2()> methods can be used. These methods take care to permit
-mail from secondary MXes.
+and C<message_result2()> methods can be used. These methods take care to
+permit mail from secondary MXes.
=head1 AUTHORS
Copied: trunk/t/00_all.t (from rev 116, trunk/t/00all.t)
Deleted: trunk/t/00all.t
===================================================================
--- trunk/t/00all.t 2005-12-07 23:48:47 UTC (rev 117)
+++ trunk/t/00all.t 2005-12-16 02:19:40 UTC (rev 118)
@@ -1,142 +0,0 @@
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl t/00all.t'
-
-#########################
-
-use Test;
-use strict;
-use Getopt::Std;
-
-my %opts;
-
-getopts('d:',\%opts);
-
-my @test_table;
-
-BEGIN {
- open TESTFILE, "test.txt";
- @test_table = grep { /\S/ and not /^\s*#/ } <TESTFILE>;
- chomp @test_table;
- close TESTFILE;
-
- plan tests => 1 + map(/\G,?(\d+)/g, @test_table);
-};
-
-use Mail::SPF::Query;
-
-# 1: did the library load okay?
-ok(1);
-
-if ($opts{d}) {
- open(TEST, ">$opts{d}") || die "Cannot open $opts{d} for output";
-}
-
-my $testnum = 2;
-
-#########################
-
-foreach my $tuple (@test_table) {
- my ($num, $domain, $ipv4, $expected_result, $expected_smtp_comment, $expected_header_comment) =
- ($tuple =~ /\t/ ? split(/\t/, $tuple) : split(' ', $tuple));
-
- my ($actual_result, $actual_smtp_comment, $actual_header_comment);
-
- my ($sender, $localpolicy) = split(':', $domain, 2);
- $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge;
- $domain = $sender;
- if ($domain =~ /\@/) { ($domain) = $domain =~ /\@(.+)/ }
-
- my $testcnt = 3;
-
- if ($expected_result =~ /=(pass|fail),/) {
- for (my $debug = 0; $debug < 2; $debug++) {
- Mail::SPF::Query->clear_cache;
- my $query = eval { new Mail::SPF::Query (ipv4 => $ipv4,
- sender => $sender,
- helo => $domain,
- debug => $debug,
- local => $localpolicy,
- ); };
-
- my $ok = 1;
- my $header_comment;
-
- $actual_result = "";
-
- foreach my $e_result (split(/,/, $expected_result)) {
- if ($e_result !~ /=/) {
- my ($msg_result, $smtp_comment);
- ($msg_result, $smtp_comment, $header_comment) = eval { $query->message_result2 };
-
- $actual_result .= $msg_result;
-
- $ok = ok($msg_result, $e_result) if (!$debug);
- if (!$ok) {
- last;
- }
- } else {
- my ($recip, $expected_recip_result) = split(/=/, $e_result, 2);
- my ($recip_result, $smtp_comment) = eval { $query->result2(split(';',$recip)) };
-
- $actual_result .= "$recip=$recip_result,";
- $testcnt++;
-
- $ok = ok($recip_result, $expected_recip_result) if (!$debug);
- if (!$ok) {
- last;
- }
- }
- }
-
- $header_comment =~ s/\S+: //; # strip the reporting hostname prefix
-
- if ($expected_header_comment) {
- $ok &= ok($header_comment, $expected_header_comment) if (!$debug);
- }
- $actual_header_comment = $header_comment;
- $actual_smtp_comment = '.';
- last if ($ok);
- }
- } else {
- my ($result, $smtp_comment, $header_comment) = eval { new Mail::SPF::Query (ipv4 => $ipv4,
- sender => $sender,
- helo => $domain,
- local => $localpolicy,
- default_explanation => "explanation",
- )->result; };
- $header_comment =~ s/^\S+: //; # strip the reporting hostname prefix
-
- my $ok = (! $expected_smtp_comment
- ? ok($result, $expected_result)
- : (ok($result, $expected_result) &&
- ok($smtp_comment, $expected_smtp_comment) &&
- ok($header_comment, $expected_header_comment)));
-
- $actual_smtp_comment = $smtp_comment;
- $actual_result = $result;
- $actual_header_comment = $header_comment;
-
- if (not $ok) {
- Mail::SPF::Query->clear_cache;
- my $result = eval { scalar(new Mail::SPF::Query (ipv4 => $ipv4,
- sender => $sender,
- helo => $domain,
- debug => 1,
- local => $localpolicy,
- )->result) };
- if ($@) {
- print " trapped error: $@\n";
- next;
- }
- }
- }
- if ($opts{d}) {
- $num = join(",", $testnum .. $testnum + $testcnt - 1);
- $testnum += $testcnt;
- print TEST join("\t", $num, $sender . ($localpolicy ? ":$localpolicy": ""), $ipv4, $actual_result, $actual_smtp_comment, $actual_header_comment),
- "\n";
- }
-}
-
-# vim:syn=perl
-------
To unsubscribe, change your address, or temporarily deactivate your subscription,
please go to http://v2.listbox.com/member/?listname=spf-devel@v2.listbox.com