diff -Nru libmail-dkim-perl-0.39/ChangeLog libmail-dkim-perl-0.40/ChangeLog --- libmail-dkim-perl-0.39/ChangeLog 2010-11-14 21:06:14.000000000 +0000 +++ libmail-dkim-perl-0.40/ChangeLog 2013-02-07 16:59:42.000000000 +0000 @@ -1,3 +1,59 @@ +2013-02-06: Jason Long + * lib/Mail/DKIM/DNS.pm: revert change that enabled EDNS0 by default; + provide enable_EDNS0() subroutine for enabling EDNS0 + * scripts/dkimverify.pl: sample verification script updated to enable + EDNS0 before performing the verification + +2013-02-06: Jason Long + * lib/Mail/DKIM/DNS.pm: set udppacketsize to 1240, which is small enough + that packet fragmentation will not normally occur; use DNS txtdata() + method on versions of Net::DNS that support it. (This patch contributed + by Mark Martinec.) + +2013-02-04: Jason Long + * lib/Mail/DKIM/DNS.pm: set default udppacketsize to 2048, which seems + to be the suggested value to use in the Net::DNS documentation. + +2013-02-04: Jason Long + * lib/Mail/DKIM/Verifier.pm: avoid an 'uninitialized value' warning when + signature being verified is missing a d= tag; accept a selector name + of '0' rather than treating it as if the s= tag was missing + * lib/Mail/DKIM/PublicKey.pm: sanity check selector/domain before + attempting a DNS query (this fixes another 'uninitialized value' warning) + * lib/Mail/DKIM/Signature.pm: avoid an 'uninitialized value' warning when + calling identity() and d= tag is missing + +2013-02-04: Jason Long + * lib/Mail/DKIM/DNS.pm: construct a default RESOLVER that sets + udppacketsize to 1280. This enables EDNS0 (extension mechanism for DNS), + allowing Mail::DKIM to handle larger keys. + +2012-11-28: Jason Long + * lib/Mail/DKIM/DNS.pm: replace use of query() with send(), since it + is never appropriate to append the default domain, and using send() + paves the way to using bgsend() in the future for async dns. + Contributed by Mark Martinec. + * lib/Mail/DKIM/DNS.pm: add global variable $RESOLVER which the + user can override if they want to specify options to Net::DNS. + +2012-11-28: Jason Long + * lib/Mail/DKIM/MessageParser.pm: rewrite of line parsing logic to + avoid unnecessary copying of the internal buffer. This replaces use + of $self->{buf} with ${$self->{buf_ref}} in many places. Patch + contributed by Mark Martinec. + +2012-11-28: Jason Long + * lib/Mail/DKIM/Signer.pm: throw proper error message if an invalid + algorithm is requested + * lib/Mail/DKIM/PublicKey.pm: further refinement to fix Perl warning + about use of uninitialized value + +2011-04-21: Jason Long + * lib/Mail/DKIM/PublicKey.pm: fix a Perl warning about use of an + uninitialized value (reported by hsk@fli-leibniz.de) + + -- VERSION 0.39 -- + 2010-11-14: Jason Long * lib/Mail/DKIM/Signer.pm: fix an unusual error message given when no Key argument has been specified and it is time to load the diff -Nru libmail-dkim-perl-0.39/Changes libmail-dkim-perl-0.40/Changes --- libmail-dkim-perl-0.39/Changes 2010-11-14 21:35:42.000000000 +0000 +++ libmail-dkim-perl-0.40/Changes 2013-02-07 20:08:45.000000000 +0000 @@ -1,6 +1,28 @@ This file summarizes what's changed between releases of Mail-DKIM. See the ChangeLog file for the details. +Version 0.40 - released 2013-02-07 + + * New/changed functionality: + * a single DNS resolver is created for the lifetime of the program, + rather than reinitializing the resolver for each new query. + + * bugfixes: + * fix the error message given when an invalid algorithm is + specified in the construction of Mail::DKIM::Signer. + * avoid Perl warning about use of an undefined value in several + places (rt.cpan.org issue #82913). + * speed- improved performance of parsing the message into lines + (rt.cpan.org issue #77902). Patch by Mark Martinec. + * fix DNS queries to use the correct method (txtdata) of Net::DNS + (rt.cpan.org issue #83170). Patch by Mark Martinec. + + * API changes: + * global subroutines resolver() or enable_EDNS0() in module + Mail::DKIM::DNS can be called to specify non-default options + to Net::DNS::Resolver (see also rt.cpan.org issue #80425). + + Version 0.39 - released 2010-11-14 * bugfixes: diff -Nru libmail-dkim-perl-0.39/META.yml libmail-dkim-perl-0.40/META.yml --- libmail-dkim-perl-0.39/META.yml 2010-11-14 21:36:40.000000000 +0000 +++ libmail-dkim-perl-0.40/META.yml 2013-02-07 20:11:35.000000000 +0000 @@ -1,19 +1,27 @@ --- #YAML:1.0 -name: Mail-DKIM -version: 0.39 -abstract: Signs/verifies Internet mail with DKIM/DomainKey signatures -license: ~ -author: +name: Mail-DKIM +version: 0.40 +abstract: Signs/verifies Internet mail with DKIM/DomainKey signatures +author: - Jason Long -generated_by: ExtUtils::MakeMaker version 6.42 -distribution_type: module -requires: - Crypt::OpenSSL::RSA: 0.24 - Digest::SHA: 0 - Mail::Address: 0 - MIME::Base64: 0 - Net::DNS: 0 - Test::Simple: 0 +license: unknown +distribution_type: module +configure_requires: + ExtUtils::MakeMaker: 0 +build_requires: + ExtUtils::MakeMaker: 0 +requires: + Crypt::OpenSSL::RSA: 0.24 + Digest::SHA: 0 + Mail::Address: 0 + MIME::Base64: 0 + Net::DNS: 0 + Test::Simple: 0 +no_index: + directory: + - t + - inc +generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.3.html - version: 1.3 + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff -Nru libmail-dkim-perl-0.39/Makefile.PL libmail-dkim-perl-0.40/Makefile.PL --- libmail-dkim-perl-0.39/Makefile.PL 2010-11-14 21:30:22.000000000 +0000 +++ libmail-dkim-perl-0.40/Makefile.PL 2013-02-07 20:08:59.000000000 +0000 @@ -4,7 +4,7 @@ # the contents of the Makefile that is written. WriteMakefile( NAME => 'Mail::DKIM', - VERSION => "0.39", + VERSION => "0.40", PREREQ_PM => { Crypt::OpenSSL::RSA => 0.24, Digest::SHA => 0, diff -Nru libmail-dkim-perl-0.39/README libmail-dkim-perl-0.40/README --- libmail-dkim-perl-0.39/README 2010-11-14 21:31:34.000000000 +0000 +++ libmail-dkim-perl-0.40/README 2012-11-28 14:23:28.000000000 +0000 @@ -1,4 +1,4 @@ -Mail-DKIM version 0.39 +Mail-DKIM version 0.40 ====================== This module implements the various components of the DKIM and DomainKeys diff -Nru libmail-dkim-perl-0.39/debian/changelog libmail-dkim-perl-0.40/debian/changelog --- libmail-dkim-perl-0.39/debian/changelog 2013-05-08 05:48:25.000000000 +0000 +++ libmail-dkim-perl-0.40/debian/changelog 2013-05-07 19:57:50.000000000 +0000 @@ -1,3 +1,12 @@ +libmail-dkim-perl (0.40-1) unstable; urgency=low + + * New upstream release. + * debian/rules: Add build-arch and build-indep targets. + * Change source format to 3.0 (quilt). + * Standards-Version 3.9.4. + + -- Magnus Holmgren Tue, 07 May 2013 21:57:38 +0200 + libmail-dkim-perl (0.39-1) unstable; urgency=low * New upstream release. diff -Nru libmail-dkim-perl-0.39/debian/control libmail-dkim-perl-0.40/debian/control --- libmail-dkim-perl-0.39/debian/control 2013-05-08 05:48:25.000000000 +0000 +++ libmail-dkim-perl-0.40/debian/control 2013-05-07 19:57:50.000000000 +0000 @@ -6,7 +6,7 @@ Build-Depends-Indep: perl (>= 5.6.0-16), liberror-perl, libnet-dns-perl, libmailtools-perl, libdigest-sha-perl, libcrypt-openssl-rsa-perl (>= 0.24) -Standards-Version: 3.9.1 +Standards-Version: 3.9.4 Vcs-Svn: svn://svn.kibibyte.se/libmail-dkim-perl/trunk Vcs-Browser: http://svn.kibibyte.se/libmail-dkim-perl Homepage: http://dkimproxy.sourceforge.net diff -Nru libmail-dkim-perl-0.39/debian/rules libmail-dkim-perl-0.40/debian/rules --- libmail-dkim-perl-0.39/debian/rules 2013-05-08 05:48:25.000000000 +0000 +++ libmail-dkim-perl-0.40/debian/rules 2013-05-06 20:33:13.000000000 +0000 @@ -13,6 +13,8 @@ TMP := $(CURDIR)/debian/$(PACKAGE) +build-arch: +build-indep: build build: build-stamp build-stamp: dh_testdir @@ -68,4 +70,4 @@ dh_builddeb binary: binary-indep -.PHONY: build clean binary-indep binary-arch binary +.PHONY: build build-arch build-indep clean binary-indep binary-arch binary diff -Nru libmail-dkim-perl-0.39/debian/source/format libmail-dkim-perl-0.40/debian/source/format --- libmail-dkim-perl-0.39/debian/source/format 1970-01-01 00:00:00.000000000 +0000 +++ libmail-dkim-perl-0.40/debian/source/format 2013-05-08 05:48:25.316466479 +0000 @@ -0,0 +1 @@ +3.0 (quilt) diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/Common.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/Common.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/Common.pm 2010-11-14 21:05:44.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/Common.pm 2012-11-28 14:23:28.000000000 +0000 @@ -15,7 +15,7 @@ package Mail::DKIM::Common; use base "Mail::DKIM::MessageParser"; use Carp; -our $VERSION = 0.39; +our $VERSION = 0.40; sub new { diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/DNS.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/DNS.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/DNS.pm 2010-01-23 17:44:52.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/DNS.pm 2013-02-07 20:09:35.000000000 +0000 @@ -1,11 +1,67 @@ #!/usr/bin/perl -# Copyright 2007 Messiah College. All rights reserved. +# Copyright 2007, 2012 Messiah College. All rights reserved. # Jason Long use strict; use warnings; +=head1 NAME + +Mail::DKIM::DNS - performs DNS queries for Mail::DKIM + +=head1 DESCRIPTION + +This is the module that performs DNS queries for L. + +=head1 CONFIGURATION + +This module has a couple configuration settings that the caller +may want to use to customize the behavior of this module. + +=head2 $Mail::DKIM::DNS::TIMEOUT + +This global variable specifies the maximum amount of time (in seconds) +to wait for a single DNS query to complete. The default is 10. + +=head2 Mail::DKIM::DNS::resolver() + +Use this global subroutine to get or replace the instance of +L that Mail::DKIM uses. If set to undef (the default), +then a brand new default instance of L will be +created the first time a DNS query is needed. + +You will call this subroutine if you want to specify non-default options +to L, such as different timeouts, or to enable use +of a persistent socket. For example: + + # first, construct a custom DNS resolver + my $res = Net::DNS::Resolver->new( + udp_timeout => 3, tcp_timeout => 3, retry => 2, + ); + $res->udppacketsize(1240); + $res->persistent_udp(1); + + # then, tell Mail::DKIM to use this resolver + Mail::DKIM::DNS::resolver($res); + +=head2 Mail::DKIM::DNS::enable_EDNS0() + +This is a convenience subroutine that will construct an appropriate DNS +resolver that uses EDNS0 (Extension mechanisms for DNS) to support large +DNS replies, and configure Mail::DKIM to use it. (As such, it should NOT +be used in conjunction with the resolver() subroutine described above.) + + Mail::DKIM::DNS::enable_EDNS0(); + +Use of EDNS0 is recommended, since it reduces the need for falling back to TCP +when dealing with large DNS packets. However, it is not enabled by default +because some Internet firewalls which do deep inspection of packets are not able +to process EDNS0-enabled packets. When there is a firewall on a path to a DNS +resolver, the EDNS0 feature should be specifically tested before enabling. + +=cut + # This class contains a method to perform synchronous DNS queries. # Hopefully some day it will have a method to perform # asynchronous DNS queries. @@ -13,6 +69,28 @@ package Mail::DKIM::DNS; use Net::DNS; our $TIMEOUT = 10; +our $RESOLVER; + +sub resolver +{ + if (@_) { + $RESOLVER = $_[0]; + } + return $RESOLVER; +} + +sub enable_EDNS0 +{ + # 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. + + my $res = Net::DNS::Resolver->new(); + $res->udppacketsize(1280-40); + resolver($res); +} # query- returns a list of RR objects # or an empty list if the domain record does not exist @@ -27,8 +105,13 @@ { my ($domain, $type) = @_; - my $rslv = Net::DNS::Resolver->new() - or die "can't create DNS resolver"; + if (! $RESOLVER) + { + $RESOLVER = Net::DNS::Resolver->new() + or die "Internal error: can't create DNS resolver"; + } + + my $rslv = $RESOLVER; # # perform the DNS query @@ -37,24 +120,30 @@ my $resp; 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; # the query itself could cause an exception, which would prevent # 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->query($domain, $type); + $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 if ($remaining_time > 0) @@ -64,17 +153,37 @@ # even at the expense of stretching the interval by one second 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"; } # query_async() - perform a DNS query asynchronously @@ -97,17 +206,32 @@ 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); }; return $waiter; } 1; + +=head1 AUTHOR + +Jason Long, Ejlong@messiah.eduE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006-2007, 2012-2013 by Messiah College + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.6 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/MessageParser.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/MessageParser.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/MessageParser.pm 2008-08-25 22:10:56.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/MessageParser.pm 2012-11-28 14:49:29.000000000 +0000 @@ -40,75 +40,81 @@ { my $self = shift; + my $buf = ''; + $self->{buf_ref} = \$buf; $self->{in_header} = 1; - $self->{buf} = ""; } sub PRINT { my $self = shift; - my $buf = $self->{buf}; - $buf .= @_ == 1 ? $_[0] : join("", @_) if @_; + my $buf_ref = $self->{buf_ref}; + $$buf_ref .= @_ == 1 ? $_[0] : join("", @_) if @_; if ($self->{in_header}) { - while (length $buf) + local $1; # avoid polluting a global $1 + while ($$buf_ref ne '') { - if (substr($buf,0,2) eq "\015\012") + if (substr($$buf_ref,0,2) eq "\015\012") { - $buf = substr($buf, 2); + substr($$buf_ref, 0, 2) = ''; $self->finish_header(); $self->{in_header} = 0; last; } - if ($buf !~ /^(.+?\015\012)[^\ \t]/s) + if ($$buf_ref !~ /^(.+?\015\012)[^\ \t]/s) { last; } my $header = $1; $self->add_header($header); - $buf = substr($buf, length($header)); + substr($$buf_ref, 0, length($header)) = ''; } } if (!$self->{in_header}) { - my $j = rindex($buf,"\015\012"); + my $j = rindex($$buf_ref,"\015\012"); if ($j >= 0) { - $self->add_body(substr($buf, 0, $j+2)); - substr($buf, 0, $j+2) = ''; + # avoid copying a large buffer: the unterminated + # last line is typically short compared to the rest + + my $carry = substr($$buf_ref, $j+2); + substr($$buf_ref, $j+2) = ''; # shrink to last CRLF + $self->add_body($$buf_ref); # must end on CRLF + $$buf_ref = $carry; # restore unterminated last line } } - $self->{buf} = $buf; return 1; } sub CLOSE { my $self = shift; - my $buf = $self->{buf}; + my $buf_ref = $self->{buf_ref}; if ($self->{in_header}) { - if (length $buf) + if ($$buf_ref ne '') { # A line of header text ending CRLF would not have been # processed yet since before we couldn't tell if it was # the complete header. Now that we're in CLOSE, we can # finish the header... - $buf =~ s/\015\012$//s; - $self->add_header("$buf\015\012"); + $$buf_ref =~ s/\015\012\z//s; + $self->add_header("$$buf_ref\015\012"); } $self->finish_header; $self->{in_header} = 0; } else { - if (length $buf) + if ($$buf_ref ne '') { - $self->add_body($buf); + $self->add_body($$buf_ref); } } - $self->{buf} = ""; + $$buf_ref = ''; $self->finish_body; return 1; } diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/Policy.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/Policy.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/Policy.pm 2010-01-23 17:44:52.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/Policy.pm 2013-02-06 21:08:41.000000000 +0000 @@ -65,17 +65,26 @@ my %callbacks = %{$prms{Callbacks} || {}}; 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; + } } unless ($strn) diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/PublicKey.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/PublicKey.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/PublicKey.pm 2010-01-23 17:44:52.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/PublicKey.pm 2013-02-07 16:59:42.000000000 +0000 @@ -83,11 +83,17 @@ my %prms = @_; my ($query_type, $query_options) = split(/\//, $prms{Protocol}, 2); - if (lc($query_type) ne "dns") + if (lc($query_type || "") ne "dns") { - die "unknown query type '$query_type'\n"; + die "unknown query type '".($query_type||"")."'\n"; } + defined($prms{Selector}) && length($prms{Selector}) + or die "invalid/missing Selector\n"; + + defined($prms{Domain}) && length($prms{Domain}) + or die "invalid/missing Domain\n"; + my $host = $prms{Selector} . "._domainkey." . $prms{Domain}; my %callbacks = %{$prms{Callbacks} || {}}; my $on_success = $callbacks{Success} || sub { $_[0] }; @@ -95,14 +101,22 @@ my @resp = @_; 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; } diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/Signature.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/Signature.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/Signature.pm 2010-11-14 21:05:44.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/Signature.pm 2013-02-07 16:59:42.000000000 +0000 @@ -703,7 +703,7 @@ } else { - return '@' . $self->domain; + return '@' . ($self->domain||""); } } diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/Signer.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/Signer.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/Signer.pm 2010-11-14 21:06:14.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/Signer.pm 2012-11-28 14:25:13.000000000 +0000 @@ -120,7 +120,7 @@ package Mail::DKIM::Signer; use base "Mail::DKIM::Common"; use Carp; -our $VERSION = 0.39; +our $VERSION = 0.40; # PROPERTIES # @@ -354,7 +354,8 @@ # create a canonicalization filter and algorithm my $algorithm_class = $signature->get_algorithm_class( - $signature->algorithm); + $signature->algorithm) + or die "unsupported algorithm " . ($signature->algorithm || "") . "\n"; my $algorithm = $algorithm_class->new( Signature => $signature, Debug_Canonicalization => $self->{Debug_Canonicalization}, diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM/Verifier.pm libmail-dkim-perl-0.40/lib/Mail/DKIM/Verifier.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM/Verifier.pm 2010-11-14 21:05:44.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM/Verifier.pm 2013-02-07 16:59:42.000000000 +0000 @@ -111,7 +111,7 @@ package Mail::DKIM::Verifier; use base "Mail::DKIM::Common"; use Carp; -our $VERSION = 0.39; +our $VERSION = 0.40; our $MAX_SIGNATURES_TO_PROCESS = 50; sub init @@ -296,16 +296,21 @@ return 0; } - unless ($signature->domain ne '') + unless (defined $signature->domain) { # no domain specified - $self->{signature_reject_reason} = - !defined($signature->domain) ? "missing d tag" - : "invalid domain in d tag"; + $self->{signature_reject_reason} = "missing d tag"; + return 0; + } + + if ($signature->domain eq '') + { + # blank domain + $self->{signature_reject_reason} = "invalid domain in d tag"; return 0; } - unless ($signature->selector) + unless (defined $signature->selector) { # no selector specified $self->{signature_reject_reason} = "missing s tag"; diff -Nru libmail-dkim-perl-0.39/lib/Mail/DKIM.pm libmail-dkim-perl-0.40/lib/Mail/DKIM.pm --- libmail-dkim-perl-0.39/lib/Mail/DKIM.pm 2010-11-14 21:05:44.000000000 +0000 +++ libmail-dkim-perl-0.40/lib/Mail/DKIM.pm 2012-11-28 14:23:28.000000000 +0000 @@ -4,7 +4,7 @@ use warnings; package Mail::DKIM; -our $VERSION = 0.39; +our $VERSION = 0.40; 1; __END__ diff -Nru libmail-dkim-perl-0.39/scripts/dkimverify.pl libmail-dkim-perl-0.40/scripts/dkimverify.pl --- libmail-dkim-perl-0.39/scripts/dkimverify.pl 2009-07-09 23:28:38.000000000 +0000 +++ libmail-dkim-perl-0.40/scripts/dkimverify.pl 2013-02-06 21:08:41.000000000 +0000 @@ -24,6 +24,10 @@ open $debugfh, ">", $debug_canonicalization or die "Error: cannot write to $debug_canonicalization: $!\n"; } + +# recommended, but may cause compatibility problems with old firewalls +Mail::DKIM::DNS::enable_EDNS0; + my $dkim = new Mail::DKIM::Verifier( Debug_Canonicalization => $debugfh, ); diff -Nru libmail-dkim-perl-0.39/t/verifier.t libmail-dkim-perl-0.40/t/verifier.t --- libmail-dkim-perl-0.39/t/verifier.t 2010-11-14 21:05:44.000000000 +0000 +++ libmail-dkim-perl-0.40/t/verifier.t 2013-02-07 16:59:42.000000000 +0000 @@ -216,7 +216,23 @@ { 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; } @@ -250,3 +266,8 @@ { return ${$_[0]}; } + +sub txtdata +{ + return ${$_[0]}; +}