| Subject: | Fixing incompatibilities with Net::DNS |
The attached patch addresses some DNS-resolver issues which
arose either due to changes brought by Net::DNS 0.69 and later,
or by revealing some hidden problems in Mail::DKIM which went by
unnoticed due to previous behaviour of Net::DNS.
1. Net::DNS [rt.cpan.org #81787]
(NXDOMAIN is no longer reported by $r->errorstring)
Net::DNS 0.69 (and 0.70) breaks Mail::DKIM, which unwarrantedly
expected that NXDOMAIN would show up in $r->errorstring.
The NLNetLabs folks were kind enough to revert the change,
nevertheless this needs to be fixed in Mail::DKIM, which
should examine rcode in a DNS reply. A NXDOMAIN is a
valid response and is not an error.
2. The Net::DNS 0.69 declares the $rr->char_str_list method
as 'historic'. As a replacement, the use of $rr->txtdata
is suggested. Because DKIM and ADSP specs require that
multiple strings in a TXT RR must be joined with no intervening
spaces the $rr->txtdata needs to be called in a list context
and letting the application join the strings the way it likes.
Unfortunately the txtdata method in Net::DNS older than 0.69
would always return a single scalar and insert spaces, so for
older versions of Net::DNS the char_str_list is still our
only choice.
See also SpamAssassin bug report:
https://issues.apache.org/SpamAssassin/show_bug.cgi?id=6872
(especially comment 12) for more insight.
3. A small update to a change in Mail::DKIM [rt.cpan.org #80425]:
reduce a default udppacketsize from 2048 to 1240, which should
be able to avoid UDP packet fragmentation in most cases
(which some environments/firewalls don't like).
Also avoid early creating a DNS resolver object which
an application may later ditch and replace with its own.
(as a side note: some packet inspecting firewalls may
choke on DNS UDP packets using EDNS0 with sizes beyond 512
bytes. Users of Mail::DKIM which do not use a local DNS
recursive server may suffer from Mail::DKIM turning on the
EDNS0 by default, so perhaps this choice should be reconsidered)
4. Some small changes to error handling: eval {} is capable
of exiting without setting the $@ (like on some signals).
The reliable way to fetch a $@ is only when eval returns
a false.
| Subject: | Mail-DKIM-0.39_6.patch |
--- Mail-DKIM-0.39_6/lib/Mail/DKIM/DNS.pm 2013-02-04 17:38:40.000000000 +0100
+++ Mail-DKIM-0.39_6-new/lib/Mail/DKIM/DNS.pm 2013-02-06 18:58:52.000000000 +0100
@@ -61,6 +61,5 @@
use Net::DNS;
our $TIMEOUT = 10;
-our $RESOLVER = Net::DNS::Resolver->new();
-$RESOLVER->udppacketsize(2048); # enables EDNS0, sets acceptable UDP packet size
+our $RESOLVER;
# query- returns a list of RR objects
@@ -77,10 +76,21 @@
my ($domain, $type) = @_;
- my $rslv = $RESOLVER || Net::DNS::Resolver->new();
- if (not $rslv)
+ if (! $RESOLVER)
{
- die "can't create DNS resolver";
+ $RESOLVER = Net::DNS::Resolver->new();
+ $RESOLVER or die "can't create DNS resolver: $@";
+
+ # enable EDNS0, set acceptable UDP packet size to a
+ # conservative payload size that should fit into a single
+ # packet (MTU less the IP header size) in most cases;
+ # See also draft-andrews-dnsext-udp-fragmentation
+ # and RFC 3542 section 11.3.
+ #
+ $RESOLVER->udppacketsize(1280-40);
}
+ my $rslv = $RESOLVER;
+ $rslv or die "DNS resolver not available";
+
#
# perform the DNS query
@@ -90,7 +100,8 @@
my $remaining_time = alarm(0); # check time left, stop the timer
my $deadline = time + $remaining_time;
+ my $E;
eval
{
- # set a 10 second timeout
+ # set a timeout, 10 seconds by default
local $SIG{ALRM} = sub { die "DNS query timeout for $domain\n" };
alarm $TIMEOUT;
@@ -99,13 +110,18 @@
# us from resetting the alarm before leaving the eval {} block
# so we wrap the query in a nested eval {} block
+ my $E2;
eval
{
$resp = $rslv->send($domain, $type);
+ 1;
+ } or do {
+ $E2 = $@;
};
- my $E = $@;
alarm 0;
- die $E if $E;
+ if ($E2) { chomp $E2; die "$E2\n" } # no line number here
+ 1;
+ } or do {
+ $E = $@; # the $@ only makes sense if eval returns a false
};
- my $E = $@;
alarm 0;
# restart the timer if it was active
@@ -117,15 +133,35 @@
alarm($dt < 1 ? 1 : $dt);
}
- die $E if $E;
+ if ($E) { chomp $E; die $E } # ensure a line number
+
+# RFC 2308: NODATA is indicated by an answer with the RCODE set to NOERROR
+# and no relevant answers in the answer section. The authority section
+# will contain an SOA record, or there will be no NS records there.
+# NODATA responses have to be algorithmically determined from the
+# response's contents as there is no RCODE value to indicate NODATA.
+# In some cases to determine with certainty that NODATA is the correct
+# response it can be necessary to send another query.
if ($resp)
{
- my @result = grep { lc $_->type eq lc $type } $resp->answer;
- return @result if @result;
- }
+ my $header = $resp->header;
+ if ($header)
+ {
+ # NOERROR, NXDOMAIN, SERVFAIL, FORMERR, REFUSED, ...
+ my $rcode = $header->rcode;
- $@ = $rslv->errorstring;
- return () if ($@ eq "NOERROR" || $@ eq "NXDOMAIN");
- die "DNS error: $@\n";
+ $@ = $rcode;
+ if ($rcode eq 'NOERROR') {
+ # may or may not contain RRs in the answer sect
+ my @result = grep { lc $_->type eq lc $type }
+ $resp->answer;
+ $@ = 'NODATA' if !@result;
+ return @result; # possibly empty
+ } elsif ($rcode eq 'NXDOMAIN') {
+ return; # empty list, rcode in $@
+ }
+ }
+ }
+ die "DNS error: " . $rslv->errorstring . "\n";
}
@@ -150,12 +186,13 @@
my $waiter = sub {
my @resp;
- my $warning;
+ my $rcode;
eval {
@resp = query($domain, $type);
- $warning = $@;
- undef $@;
+ $rcode = $@;
+ 1;
+ } or do {
+ return $on_error->($@);
};
- $@ and return $on_error->($@);
- $@ = $warning;
+ $@ = $rcode;
return $on_success->(@resp);
};
--- Mail-DKIM-0.39_6/lib/Mail/DKIM/Policy.pm 2013-02-04 16:31:34.000000000 +0100
+++ Mail-DKIM-0.39_6-new/lib/Mail/DKIM/Policy.pm 2013-02-06 17:24:20.000000000 +0100
@@ -66,15 +66,24 @@
my $on_success = $callbacks{Success} || sub { $_[0] };
$callbacks{Success} = sub {
- my $resp = shift;
- unless ($resp)
+ my @resp = @_;
+ unless (@resp)
{
- # no response => NXDOMAIN, use default policy
+ # no requested resource records or NXDOMAIN,
+ # use default policy
return $on_success->($class->default);
}
my $strn;
- foreach my $ans ($resp) {
- next unless $ans->type eq "TXT";
- $strn = join "", $ans->char_str_list;
+ foreach my $rr (@resp) {
+ next unless $rr->type eq "TXT";
+
+ # join with no intervening spaces, RFC 5617
+ if (Net::DNS->VERSION >= 0.69) {
+ # must call txtdata() in a list context
+ $strn = join "", $rr->txtdata;
+ } else {
+ # char_str_list method is 'historical'
+ $strn = join "", $rr->char_str_list;
+ }
}
--- Mail-DKIM-0.39_6/lib/Mail/DKIM/PublicKey.pm 2013-02-04 17:06:41.000000000 +0100
+++ Mail-DKIM-0.39_6-new/lib/Mail/DKIM/PublicKey.pm 2013-02-06 17:24:27.000000000 +0100
@@ -102,12 +102,20 @@
unless (@resp)
{
- # no response => NXDOMAIN
+ # no requested resource records or NXDOMAIN,
return $on_success->();
}
my $strn;
- foreach my $ans (@resp) {
- next unless $ans->type eq "TXT";
- $strn = join "", $ans->char_str_list;
+ foreach my $rr (@resp) {
+ next unless $rr->type eq "TXT";
+
+ # join with no intervening spaces, RFC 6376
+ if (Net::DNS->VERSION >= 0.69) {
+ # must call txtdata() in a list context
+ $strn = join "", $rr->txtdata;
+ } else {
+ # char_str_list method is 'historical'
+ $strn = join "", $rr->char_str_list;
+ }
last;
}
--- Mail-DKIM-0.39_6/t/verifier.t 2012-11-28 15:23:28.000000000 +0100
+++ Mail-DKIM-0.39_6-new/t/verifier.t 2013-02-06 19:07:50.000000000 +0100
@@ -217,5 +217,21 @@
warn "did not cache that DNS entry: $domain\n";
print STDERR ">>>\n";
- print STDERR join("", (Mail::DKIM::DNS::orig_query($domain, $type))[0]->char_str_list) . "\n";
+ my @result = Mail::DKIM::DNS::orig_query($domain, $type);
+ if (!@result) {
+ print STDERR "No results: $@\n";
+ } else {
+ foreach my $rr (@result) {
+ # join with no intervening spaces, RFC 6376
+ if (Net::DNS->VERSION >= 0.69) {
+ # must call txtdata() in a list context
+ printf STDERR ("%s\n",
+ join("", $rr->txtdata));
+ } else {
+ # char_str_list method is 'historical'
+ printf STDERR ("%s\n",
+ join("", $rr->char_str_list));
+ }
+ }
+ }
print STDERR "<<<\n";
die;
@@ -251,2 +267,7 @@
return ${$_[0]};
}
+
+sub txtdata
+{
+ return ${$_[0]};
+}