Net-DNS-1.07/0000755000175000017500000000000013031240175012151 5ustar willemwillemNet-DNS-1.07/META.json0000644000175000017500000000262213031240175013574 0ustar willemwillem{ "abstract" : "Perl Interface to the Domain Name System", "author" : [ "Olaf Kolkman et al" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.18, CPAN::Meta::Converter version 2.143240", "license" : [ "mit" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-DNS", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "recommends" : { "Digest::BubbleBabble" : "0.01", "Digest::GOST" : "0.06", "IO::Socket::INET6" : "2.51", "IO::Socket::IP" : "0.32", "Net::LibIDN" : "0.12", "Scalar::Util" : "1.25" }, "requires" : { "Digest::HMAC" : "1.03", "Digest::MD5" : "2.13", "Digest::SHA" : "5.23", "File::Spec" : "0.86", "IO::Socket" : "1.16", "MIME::Base64" : "2.11", "Test::More" : "0.52", "Time::Local" : "1.19", "perl" : "5.00404" } } }, "release_status" : "stable", "version" : "1.07" } Net-DNS-1.07/README0000644000175000017500000002533313031240164013035 0ustar willemwillem Net::DNS - Perl DNS Resolver Module =================================== TABLE OF CONTENTS ----------------- 1. Description 2. Availability 3. Prerequisites 4. Installation 5. Running Tests 6. Demonstration Scripts 7. Dynamic Updates 8. Signed Queries & Updates 9. DNSSEC 10. Bugs 11. Copyright 12. License 13. Staying Tuned 14. Acknowledgments 1. DESCRIPTION ----------- Net::DNS is a DNS resolver implemented in Perl. It allows the programmer to perform nearly any type of DNS query from a Perl script. For details and examples, please read the Net::DNS manual page. To read about the latest features, see the Changes file. To find out about known bugs and to see what is planned for future versions, see the CPAN RT ticket list. The author invites feedback on Net::DNS. If there is something you would like to have added, please let me know. If you find a bug, please send me the information described in the BUGS section below. See http://www.net-dns.org/blog/ for announcements about Net::DNS. 2. AVAILABILITY ------------ You can get the latest version of Net::DNS from the Comprehensive Perl Archive Network (CPAN) or from the module's homepage: http://search.cpan.org/dist/Net-DNS/ or through http://www.net-dns.org/ Additionally a subversion repository is made available through http://www.net-dns.org/svn/net-dns/ The version on the "trunk" (http://www.net-dns.org/svn/net-dns/trunk) is the version that is targeted for next release. Please note that the SVN version at any given moment may be broken. 3. PREREQUISITES ------------- The availability of prerequisites for Net::DNS is tested at installation time. These are the core packages that need to be available: Digest::HMAC Digest::MD5 Digest::SHA File::Spec IO::Socket MIME::Base64 Time::Local Test::More The availability of these optional packages is tested at runtime: Digest::BubbleBabble Digest::GOST IO::Socket::INET6 IO::Socket::IP Net::DNS::SEC Net::LibIDN You can obtain the latest version of Perl from: http://www.cpan.org Some of the demonstration and contributed scripts may require additional modules -- see demo/README and contrib/README for details. Note that the Test::More module is actually part of the Test-Simple distribution. See the FAQ (lib/Net/DNS/FAQ.pod) for more information. 4. INSTALLATION ------------ Please install any modules mentioned in the PREREQUISITES section above. If you do not, some features of Net::DNS will not work. When you run "perl Makefile.PL", Perl should complain if any of the required modules is missing. To build this module, run the following commands: tar xvzf Net-DNS-?.??.tar.gz cd Net-DNS-?.?? perl Makefile.PL make make test make install If you do not wish to run the online tests, the '--no-online-tests' option can be used. Similarly, '--online-tests' will enable the online tests. Online tests will be run by default, but the result will not adversely affect the outcome of test suite. Also, if you do not wish to run the IPv6 tests, the '--no-IPv6-tests' option can be used. Similarly, '--IPv6-tests' will enable the IPv6 tests. 5. RUNNING TESTS ------------- If any of the tests fail, please contact the author with the output from the following command: make test TEST_VERBOSE=1 6. DEMONSTRATION SCRIPTS --------------------- There are a few demonstration scripts in the demo/ directory -- see demo/README for more information. Contributed scripts are in the contrib/ directory -- see contrib/README. The author would be happy to include any contributed scripts in future versions of this module. All I ask is that they be documented (preferably using POD) and that the contributor's name and contact information be mentioned somewhere. 7. DYNAMIC UPDATES --------------- Net::DNS supports DNS dynamic updates as documented in RFC 2136; for more information and examples, please see the Net::DNS::Update manual page. Here is a summary of the update semantics for those interested (see RFC 2136 for details): PREREQUISITE SECTION # RRs NAME TTL CLASS TYPE RDLENGTH RDATA ----- ---- --- ----- ---- -------- ----- yxrrset 1 name 0 ANY type 0 empty yxrrset 1+ name 0 class type rdlength rdata nxrrset 1 name 0 NONE type 0 empty yxdomain 1 name 0 ANY ANY 0 empty nxdomain 1 name 0 NONE ANY 0 empty UPDATE SECTION # RRs NAME TTL CLASS TYPE RDLENGTH RDATA ----- ---- --- ----- ---- -------- ----- add RRs 1+ name ttl class type rdlength rdata del RRset 1 name 0 ANY type 0 empty del all RRsets 1 name 0 ANY ANY 0 empty del RRs 1+ name 0 NONE type rdlength rdata 8. SIGNED QUERIES & UPDATES ------------------------ Net::DNS supports the TSIG resource record to perform signed queries and updates (RFC 2845). See the Net::DNS::Packet and Net::DNS::Update manual pages for examples. If you're using the BIND nameserver, the BIND FAQ shows how to generate keys and configure the nameserver to use them: http://www.nominum.com/resources/faqs/bind-faq.html TSIG support is new and isn't yet complete. Please use with caution on production systems. Feedback on TSIG functionality would be most welcome. 9. DNSSEC ------ The extensions to enable the DNSSEC signature generation and verification functions are distributed separately as Net::DNS::SEC. The package is available from CPAN. 10. BUGS ---- Net::DNS, although begun in 1997, is still under development and may still contain a few bugs. Please see CPAN RT and Changes file for more information. We recommend that you exercise caution when using Net::DNS to maintain a production nameserver via dynamic updates. Always test your code *thoroughly*. The Net::DNS authors accept no blame if you corrupt your zone. That warning in place, We are aware of one large company that has used Net::DNS to make thousands of dynamic updates per day for at least three years without any problems. Please use the following form to submit bug reports: https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-DNS If you find any bugs, please report each in a separate "rt.cpan.org" report along with the following information: * subject field containing a concise descriptive summary * version of Perl (output of 'perl -V' is best) * version of Net::DNS * operating system type and version * version of nameserver (if known) * exact text of error message or description of problem * the shortest possible program that exhibits the problem * the specific queries you are making, if the fault can be demonstrated using Internet nameservers If we do not have access to a system similar to yours, you may be asked to insert some debugging lines and report back on the results. The more focussed the help and information you provide, the better. Net::DNS is currently maintained at NLnet Labs (www.nlnetlabs.nl) by: Willem Toorop. Between 2005 and 2012 Net::DNS was maintained by: Olaf Kolkman and his team. Between 2002 and 2004 Net::DNS was maintained by Chris Reinhardt. Net::DNS was created in 1997 by Michael Fuhr. 11. COPYRIGHT --------- Authorship of individual components and significant contributions is shown in the copyright notice attached to the relevant documentation. Copyright in all components is retained by their respective authors. 12. LICENSE ------- Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 13. STAYING TUNED ------------- http://www.net-dns.org is a web site dedicated to the development of Net::DNS. Announcements about Net::DNS and Net::DNS::SEC will be done through the Net::DNS weblog at http://www.net-dns.org/blog/. An RSS feed for the weblog is available. If you want to have access to the latest and greatest code a subversion repository is made available through http://www.net-dns.org/svn/net-dns/ The version on the "trunk" (http://www.net-dns.org/svn/net-dns/trunk) is the version that is targeted for next release. Please note that code from the SVN repositories trunk and development branches may be broken at any time. 14. ACKNOWLEDGMENTS --------------- Thanks to Mike for letting me take care of his baby. Thanks to Chris for maintaining Net::DNS for a couple of years. Thanks to Olaf for maintaining Net::DNS for over eight years. Thanks to Rob Brown and Dick Franks for all their patches and input. Thanks to all who have used Net::DNS and reported bugs, made suggestions, contributed code, and encouraged me to add certain features. Many of these people are mentioned by name in the Changes and TODO files; lack of mention should be considered an oversight and not a conscious act of omission. Thanks to Larry Wall and all who have made Perl possible. Thanks to Paul Albitz and Cricket Liu for allowing me [OK: that is Mike] to write the Net::DNS section in the programming chapter of DNS and BIND, 3rd Edition. This chapter in earlier editions was very helpful while I was developing Net::DNS, and I was proud to contribute to it. Thanks to Paul Vixie and all who have worked on the BIND nameserver, which I've used exclusively while developing Net::DNS. Thanks to Andreas Gustafsson for DNAME support, and for all the work he has done on BIND 9. Olaf acknowledges the RIPE NCC for allowing Net::DNS maintenance to take place as part of 'the job'. Thanks to the team that maintains wireshark. Without its marvelous interface, debugging of bugs in wireformat would be so much more difficult. Thanks to the thousands who participate in the open-source community. I have always developed Net::DNS using open-source systems and I am proud to make Net::DNS freely available to the world. ---- $Id: README 1509 2016-10-03 12:59:22Z willem $ Net-DNS-1.07/MANIFEST0000644000175000017500000000766713031240175013322 0ustar willemwillemChanges contrib/check_soa contrib/check_zone contrib/dnswalk.README contrib/find_zonecut contrib/loc2earth.fcgi contrib/loclist.pl contrib/README demo/axfr demo/check_soa demo/check_zone demo/example_recurse.pl demo/mresolv demo/mx demo/perldig demo/README demo/trace_dns.pl lib/Net/DNS.pm lib/Net/DNS/Domain.pm lib/Net/DNS/DomainName.pm lib/Net/DNS/FAQ.pod lib/Net/DNS/Header.pm lib/Net/DNS/Mailbox.pm lib/Net/DNS/Nameserver.pm lib/Net/DNS/Packet.pm lib/Net/DNS/Parameters.pm lib/Net/DNS/Question.pm lib/Net/DNS/Resolver.pm lib/Net/DNS/Resolver/android.pm lib/Net/DNS/Resolver/Base.pm lib/Net/DNS/Resolver/cygwin.pm lib/Net/DNS/Resolver/MSWin32.pm lib/Net/DNS/Resolver/os2.pm lib/Net/DNS/Resolver/Recurse.pm lib/Net/DNS/Resolver/UNIX.pm lib/Net/DNS/RR.pm lib/Net/DNS/RR/A.pm lib/Net/DNS/RR/AAAA.pm lib/Net/DNS/RR/AFSDB.pm lib/Net/DNS/RR/APL.pm lib/Net/DNS/RR/CAA.pm lib/Net/DNS/RR/CDNSKEY.pm lib/Net/DNS/RR/CDS.pm lib/Net/DNS/RR/CERT.pm lib/Net/DNS/RR/CNAME.pm lib/Net/DNS/RR/CSYNC.pm lib/Net/DNS/RR/DHCID.pm lib/Net/DNS/RR/DLV.pm lib/Net/DNS/RR/DNAME.pm lib/Net/DNS/RR/DNSKEY.pm lib/Net/DNS/RR/DS.pm lib/Net/DNS/RR/EUI48.pm lib/Net/DNS/RR/EUI64.pm lib/Net/DNS/RR/GPOS.pm lib/Net/DNS/RR/HINFO.pm lib/Net/DNS/RR/HIP.pm lib/Net/DNS/RR/IPSECKEY.pm lib/Net/DNS/RR/ISDN.pm lib/Net/DNS/RR/KEY.pm lib/Net/DNS/RR/KX.pm lib/Net/DNS/RR/L32.pm lib/Net/DNS/RR/L64.pm lib/Net/DNS/RR/LOC.pm lib/Net/DNS/RR/LP.pm lib/Net/DNS/RR/MB.pm lib/Net/DNS/RR/MG.pm lib/Net/DNS/RR/MINFO.pm lib/Net/DNS/RR/MR.pm lib/Net/DNS/RR/MX.pm lib/Net/DNS/RR/NAPTR.pm lib/Net/DNS/RR/NID.pm lib/Net/DNS/RR/NS.pm lib/Net/DNS/RR/NSEC.pm lib/Net/DNS/RR/NSEC3.pm lib/Net/DNS/RR/NSEC3PARAM.pm lib/Net/DNS/RR/NULL.pm lib/Net/DNS/RR/OPENPGPKEY.pm lib/Net/DNS/RR/OPT.pm lib/Net/DNS/RR/PTR.pm lib/Net/DNS/RR/PX.pm lib/Net/DNS/RR/RP.pm lib/Net/DNS/RR/RRSIG.pm lib/Net/DNS/RR/RT.pm lib/Net/DNS/RR/SIG.pm lib/Net/DNS/RR/SMIMEA.pm lib/Net/DNS/RR/SOA.pm lib/Net/DNS/RR/SPF.pm lib/Net/DNS/RR/SRV.pm lib/Net/DNS/RR/SSHFP.pm lib/Net/DNS/RR/TKEY.pm lib/Net/DNS/RR/TLSA.pm lib/Net/DNS/RR/TSIG.pm lib/Net/DNS/RR/TXT.pm lib/Net/DNS/RR/URI.pm lib/Net/DNS/RR/X25.pm lib/Net/DNS/Text.pm lib/Net/DNS/Update.pm lib/Net/DNS/ZoneFile.pm Makefile.PL MANIFEST This list of files README t/.resolv.conf t/00-load.t t/00-pod.t t/00-version.t t/01-resolver-env.t t/01-resolver-file.t t/01-resolver-flags.t t/01-resolver-opt.t t/01-resolver.t t/02-domain.t t/02-domainname.t t/02-mailbox.t t/02-text.t t/03-header.t t/03-question.t t/03-rr.t t/04-packet.t t/04-packet-truncate.t t/05-A.t t/05-AAAA.t t/05-AFSDB.t t/05-APL.t t/05-CAA.t t/05-CDNSKEY.t t/05-CDS.t t/05-CERT.t t/05-CNAME.t t/05-CSYNC.t t/05-DHCID.t t/05-DLV.t t/05-DNAME.t t/05-DNSKEY.t t/05-DS.t t/05-EUI48.t t/05-EUI64.t t/05-HINFO.t t/05-HIP.t t/05-IPSECKEY.t t/05-ISDN.t t/05-L32.t t/05-L64.t t/05-LP.t t/05-LOC.t t/05-KEY.t t/05-KX.t t/05-MINFO.t t/05-MX.t t/05-NAPTR.t t/05-NID.t t/05-NULL.t t/05-NS.t t/05-NSEC.t t/05-NSEC3.t t/05-NSEC3PARAM.t t/05-OPENPGPKEY.t t/05-OPT.t t/05-PTR.t t/05-PX.t t/05-RP.t t/05-RRSIG.t t/05-RT.t t/05-SIG.t t/05-SMIMEA.t t/05-SOA.t t/05-SPF.t t/05-SRV.t t/05-SSHFP.t t/05-TKEY.t t/05-TLSA.t t/05-TSIG.t t/05-TXT.t t/05-URI.t t/05-X25.t t/06-packet-unique-push.t t/06-update.t t/07-rrsort.t t/07-zonefile.t t/08-IPv4.t t/08-IPv6.t t/08-recurse.t t/21-TSIG-create.t t/22-TSIG-verify.t t/31-NSEC-typelist.t t/32-NSEC3-typelist.t t/33-NSEC3-hash.t t/34-NSEC3-flags.t t/35-NSEC3-match.t t/36-NSEC3-covered.t t/37-NSEC3-base32.t t/41-DNSKEY-keytag.t t/42-DNSKEY-flags.t t/43-DNSKEY-keylength.t t/51-DS-SHA1.t t/52-DS-SHA256.t t/53-DS-GOST.t t/54-DS-SHA384.t t/61-SIG0-RSAMD5.t t/63-RRSIG-DSA.t t/65-RRSIG-RSASHA1.t t/66-RRSIG-NSEC3DSA.t t/67-RRSIG-NSEC3RSASHA1.t t/68-RRSIG-RSASHA256.t t/70-RRSIG-RSASHA512.t t/72-RRSIG-ECC-GOST.t t/73-RRSIG-ECDSAP256SHA256.t t/74-RRSIG-ECDSAP384SHA384.t t/99-cleanup.t t/NonFatal.pm t/custom.txt META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-DNS-1.07/t/0000755000175000017500000000000013031240175012414 5ustar willemwillemNet-DNS-1.07/t/01-resolver.t0000644000175000017500000000520713031240164014662 0ustar willemwillem# $Id: 01-resolver.t 1512 2016-10-26 09:14:27Z willem $ -*-perl-*- use strict; use Test::More tests => 24; use Net::DNS; my $resolver = Net::DNS::Resolver->new( prefer_v4 => 1 ); my $class = ref($resolver); for (@Net::DNS::Resolver::ISA) { diag $_ unless /[:]UNIX$/; } ok( $resolver->isa('Net::DNS::Resolver'), 'new() created object' ); ok( $resolver->print, '$resolver->print' ); ok( $class->new( debug => 1 )->_diag(@Net::DNS::Resolver::ISA), 'debug message' ); { ## check class methods ok( $class->domain('example.com'), 'class->domain' ); ok( $class->searchlist('example.com'), 'class->searchlist' ); $class->nameservers(qw(127.0.0.1 ::1)); ok( $class->srcport(1234), 'class->srcport' ); ok( $class->string(), 'class->string' ); } { ## check instance methods ok( $resolver->domain('example.com'), 'resolver->domain' ); ok( $resolver->searchlist('example.com'), 'resolver->searchlist' ); $resolver->nameservers(qw(127.0.0.1 ::1)); ok( $resolver->nameservers(), 'resolver->nameservers' ); ok( $resolver->nameserver(), 'resolver->nameserver' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->force_v6(1); ok( !$resolver->nameservers(qw(127.0.0.1)), 'no IPv4 nameservers' ); like( $resolver->errorstring, '/IPv4.+disabled/', 'errorstring: IPv4 disabled' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->force_v4(1); ok( !$resolver->nameservers(qw(::)), 'no IPv6 nameservers' ); like( $resolver->errorstring, '/IPv6.+disabled/', 'errorstring: IPv6 disabled' ); } { my $resolver = Net::DNS::Resolver->new(); foreach my $value (qw(1.2.3.4 ::1 ::1.2.3.4)) { is( $resolver->srcaddr($value), $value, "resolver->srcaddr($value)" ); } } { ## exercise possibly unused socket code my $resolver = Net::DNS::Resolver->new(); foreach my $value (qw(127.0.0.1 ::1)) { my $udp = eval { $resolver->_create_udp_socket($value) }; ok( !$@, "resolver->_create_udp_socket($value)" ); my $tcp = eval { $resolver->_create_tcp_socket($value) }; ok( !$@, "resolver->_create_tcp_socket($value)" ); } } { ## check for exception on bogus AUTOLOAD method eval { $resolver->bogus(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown method:\t[$exception]" ); is( $resolver->DESTROY, undef, 'DESTROY() exists to defeat pre-5.18 AUTOLOAD' ); } eval { ## exercise warning for make_query_packet() local *STDERR; my $filename = '01-resolver.tmp'; open( STDERR, ">$filename" ) || die "Could not open $filename for writing"; $resolver->make_query_packet('example.com'); # carp $resolver->make_query_packet('example.com'); # silent close(STDERR); unlink($filename); }; exit; __END__ Net-DNS-1.07/t/.resolv.conf0000644000175000017500000000025713031240164014655 0ustar willemwillem# $Id: .resolv.conf 1414 2015-10-12 09:42:19Z willem $ domain t.net-dns.org search net-dns.org lib.net-dns.org nameserver 10.0.1.128 10.0.2.128 options attempts:2 inet6 bogus Net-DNS-1.07/t/01-resolver-env.t0000644000175000017500000000174413031240164015452 0ustar willemwillem# $Id: 01-resolver-env.t 1412 2015-10-12 08:19:51Z willem $ -*-perl-*- use strict; use Test::More tests => 10; local $ENV{'RES_NAMESERVERS'} = '10.0.3.128 10.0.4.128'; local $ENV{'RES_SEARCHLIST'} = 'net-dns.org lib.net-dns.org'; local $ENV{'LOCALDOMAIN'} = 'net-dns.org'; local $ENV{'RES_OPTIONS'} = 'retrans:3 retry:2 debug bogus'; use Net::DNS; my $res = Net::DNS::Resolver->new; ok( $res->isa('Net::DNS::Resolver'), 'new() created object' ); is( $res->domain, 'net-dns.org', 'domain works' ); my @search = $res->searchlist; is( $search[0], 'net-dns.org', 'searchlist correct' ); is( $search[1], 'lib.net-dns.org', 'searchlist correct' ); my @servers = $res->nameservers; ok( scalar(@servers), "nameservers() works" ); is( $servers[0], '10.0.3.128', 'nameservers list correct' ); is( $servers[1], '10.0.4.128', 'nameservers list correct' ); is( $res->retrans, 3, 'retrans works' ); is( $res->retry, 2, 'retry works' ); is( $res->debug, 1, 'debug() works' ); exit; Net-DNS-1.07/t/05-APL.t0000644000175000017500000000462713031240164013446 0ustar willemwillem# $Id: 05-APL.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 31; use Net::DNS; my $name = 'APL.example'; my $type = 'APL'; my $code = 42; my @attr = qw( aplist ); my @data = qw( 1:224.0.0.0/4 2:FF00::0/16 !1:192.168.38.0/28 1:224.0.0.0/0 2:FF00::0/0 ); my @also = qw( string negate family address ); # apitem attributes my $wire = '00010401e000021001ff00011c83c0a8260001000000020000'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); foreach my $item ( $rr->aplist ) { foreach (@also) { ok( defined( $item->$_ ), "aplist item->$_() attribute" ); } } } { my $rr = new Net::DNS::RR("$name $type @data"); my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); my @wire = unpack 'C*', $encoded; $wire[length($empty) - 1]--; my $wireformat = pack 'C*', @wire; eval { decode Net::DNS::RR( \$wireformat ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } { eval { new Net::DNS::RR("$name $type 0:0::0/0"); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown address family\t[$exception]" ); } exit; Net-DNS-1.07/t/54-DS-SHA384.t0000644000175000017500000000224613031240164014207 0ustar willemwillem# $Id: 54-DS-SHA384.t 1352 2015-06-02 08:13:13Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::SHA MIME::Base64 Net::DNS::RR::DNSKEY Net::DNS::RR::DS ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 3; # Simple known-answer tests based upon the examples given in RFC6605, section 6.2 my $dnskey = new Net::DNS::RR <<'END'; example.net. 3600 IN DNSKEY 257 3 14 ( xKYaNhWdGOfJ+nPrL8/arkwf2EY3MDJ+SErKivBVSum1 w/egsXvSADtNJhyem5RCOpgQ6K8X1DRSEkrbYQ+OB+v8 /uX45NBwY8rp65F6Glur8I/mlVNgF6W/qTI37m40 ) END my $ds = new Net::DNS::RR <<'END'; example.net. 3600 IN DS 10771 14 4 ( 72d7b62976ce06438e9c0bf319013cf801f09ecc84b8 d7e9495f27e305c6a9b0563a9b5f4d288405c3008a94 6df983d6 ) END my $test = create Net::DNS::RR::DS( $dnskey, digtype => 'SHA384', ttl => 3600 ); is( $test->string, $ds->string, 'created DS matches RFC6605 example DS' ); ok( $test->verify($dnskey), 'created DS verifies RFC6605 example DNSKEY' ); ok( $ds->verify($dnskey), 'RFC6605 example DS verifies DNSKEY' ); $ds->print; __END__ Net-DNS-1.07/t/34-NSEC3-flags.t0000644000175000017500000000114213031240164014726 0ustar willemwillem# $Id: 34-NSEC3-flags.t 1389 2015-09-09 13:09:43Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Net::DNS::RR::NSEC3; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 3; my $rr = new Net::DNS::RR( type => 'NSEC3' ); my $optout = $rr->optout; ok( !$optout, 'Boolean optout flag has default value' ); $rr->optout( !$optout ); ok( $rr->optout, 'Boolean optout flag toggled' ); $rr->optout($optout); ok( !$optout, 'Boolean optout flag restored' ); exit; __END__ Net-DNS-1.07/t/05-CSYNC.t0000644000175000017500000000445013031240164013703 0ustar willemwillem# $Id: 05-CSYNC.t 1370 2015-07-01 13:48:40Z willem $ -*-perl-*- use strict; use Test::More tests => 20; use Net::DNS; my $name = 'alpha.example.com'; my $type = 'CSYNC'; my $code = 62; my @attr = qw( SOAserial flags typelist); my @data = qw( 66 3 A NS AAAA); my @hash = ( 66, 3, q(A NS AAAA) ); my @also = qw( immediate soaminimum ); my $wire = '000000420003000460000008'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @hash; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { my $a = join ' ', sort split /\s+/, $rr->$_; # typelist order unspecified my $b = join ' ', sort split /\s+/, $hash->{$_}; is( $a, $b, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } ok( $rr->immediate(1), 'set $rr->immediate' ); ok( !$rr->immediate(0), 'clear $rr->immediate' ); ok( $rr->soaminimum(1), 'set $rr->soaminimum' ); ok( !$rr->soaminimum(0), 'clear $rr->soaminimum' ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/03-header.t0000644000175000017500000001201013031240164014241 0ustar willemwillem# $Id: 03-header.t 1404 2015-09-22 13:38:04Z willem $ use strict; use Test::More; use Net::DNS::Packet; use Net::DNS::Parameters; my @op = keys %Net::DNS::Parameters::opcodebyname; my @rc = keys %Net::DNS::Parameters::rcodebyname; plan tests => 76 + scalar(@op) + scalar(@rc); my $packet = new Net::DNS::Packet(qw(. NS IN)); my $header = $packet->header; ok( $header->isa('Net::DNS::Header'), 'packet->header object' ); sub waggle { my $object = shift; my $attribute = shift; my @sequence = @_; for my $value (@sequence) { my $change = $object->$attribute($value); my $stored = $object->$attribute(); is( $stored, $value, "expected value after header->$attribute($value)" ); } } { ## check conversion functions foreach ( sort( keys %Net::DNS::Parameters::opcodebyname ), 15 ) { my $expect = /NS_NOTIFY/i ? 'NOTIFY' : uc($_); my $name = eval { my $val = opcodebyname($_); opcodebyval( opcodebyname($val) ); }; my $exception = $@ =~ /^(.+)\n/ ? $1 : ''; is( $name, $expect, "opcodebyname('$_')\t$exception" ); } foreach my $testcase ('BOGUS') { eval { opcodebyname($testcase); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "opcodebyname($testcase)\t[$exception]" ); } } { foreach ( sort( keys %Net::DNS::Parameters::rcodebyname ), 4000 ) { my $expect = /BADVERS/i ? 'BADSIG' : uc($_); my $name = eval { my $val = rcodebyname($_); rcodebyval( rcodebyname($val) ); }; my $exception = $@ =~ /^(.+)\n/ ? $1 : ''; is( $name, $expect, "rcodebyname('$_')\t$exception" ); } foreach my $testcase ('BOGUS') { eval { rcodebyname($testcase); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "rcodebyname($testcase)\t[$exception]" ); } } my $newid = new Net::DNS::Packet->header->id; waggle( $header, 'id', $header->id, $newid, $header->id ); waggle( $header, 'opcode', qw(STATUS UPDATE QUERY) ); waggle( $header, 'rcode', qw(REFUSED FORMERR NOERROR) ); waggle( $header, 'qr', 1, 0, 1, 0 ); waggle( $header, 'aa', 1, 0, 1, 0 ); waggle( $header, 'tc', 1, 0, 1, 0 ); waggle( $header, 'rd', 0, 1, 0, 1 ); waggle( $header, 'ra', 1, 0, 1, 0 ); waggle( $header, 'ad', 1, 0, 1, 0 ); waggle( $header, 'cd', 1, 0, 1, 0 ); # # Is $header->string remotely sane? # like( $header->string, '/opcode = QUERY/', 'string() has QUERY opcode' ); like( $header->string, '/qdcount = 1/', 'string() has qdcount correct' ); like( $header->string, '/ancount = 0/', 'string() has ancount correct' ); like( $header->string, '/nscount = 0/', 'string() has nscount correct' ); like( $header->string, '/arcount = 0/', 'string() has arcount correct' ); $header->opcode('UPDATE'); like( $header->string, '/opcode = UPDATE/', 'string() has UPDATE opcode' ); like( $header->string, '/zocount = 1/', 'string() has zocount correct' ); like( $header->string, '/prcount = 0/', 'string() has prcount correct' ); like( $header->string, '/upcount = 0/', 'string() has upcount correct' ); like( $header->string, '/adcount = 0/', 'string() has adcount correct' ); # # Check that the aliases work # my $rr = new Net::DNS::RR('example.com. 10800 A 192.0.2.1'); my @rr = ( $rr, $rr ); $packet->push( prereq => $rr ); $packet->push( update => $rr, @rr ); $packet->push( additional => @rr, @rr ); is( $header->zocount, $header->qdcount, 'zocount value matches qdcount' ); is( $header->prcount, $header->ancount, 'prcount value matches ancount' ); is( $header->upcount, $header->nscount, 'upcount value matches nscount' ); is( $header->adcount, $header->arcount, 'adcount value matches arcount' ); foreach my $method (qw(qdcount ancount nscount arcount)) { eval { local $SIG{__WARN__} = sub { die @_ }; my $was = $Net::DNS::Header::warned; $Net::DNS::Header::warned = 0; $header->$method(1); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "$method read-only:\t[$exception]" ); eval { local $SIG{__WARN__} = sub { die @_ }; $header->$method(1); }; my $repeated = $1 if $@ =~ /^(.+)\n/; ok( !$repeated, "$method exception not repeated" ); } my $data = $packet->data; my $packet2 = new Net::DNS::Packet( \$data ); my $string = $packet->header->string; is( $packet2->header->string, $string, 'encode/decode transparent' ); SKIP: { my $size = $header->size; my $edns = $header->edns; ok( $edns->isa('Net::DNS::RR::OPT'), 'header->edns object' ); skip( 'EDNS header extensions not supported', 10 ) unless $edns->isa('Net::DNS::RR::OPT'); waggle( $header, 'do', 0, 1, 0, 1 ); waggle( $header, 'rcode', qw(BADVERS BADMODE BADNAME FORMERR NOERROR) ); my $packet = new Net::DNS::Packet(); # empty EDNS size solicitation my $udplim = 1280; $packet->edns->size($udplim); my $encoded = $packet->data; my $decoded = new Net::DNS::Packet( \$encoded ); is( $decoded->edns->size, $udplim, 'EDNS size request assembled correctly' ); } eval { ## exercise printing functions my $filename = "03-header.tmp"; open( TEMP, ">$filename" ) || die "Could not open $filename for writing"; select( ( select(TEMP), $header->print )[0] ); close(TEMP); unlink($filename); }; exit; Net-DNS-1.07/t/32-NSEC3-typelist.t0000644000175000017500000000317313031240164015513 0ustar willemwillem# $Id: 32-NSEC3-typelist.t 1389 2015-09-09 13:09:43Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; use Net::DNS::Parameters; use Net::DNS::Text; my @prerequisite = qw( Net::DNS::RR::NSEC3; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 79; my $rr = new Net::DNS::RR( type => 'NSEC3', hnxtname => 'irrelevant', ); foreach my $rrtype ( 0, 256, 512, 768, 1024 ) { my $type = typebyval($rrtype); $rr->typelist($type); my $rdata = $rr->rdata; my ( $text, $offset ) = decode Net::DNS::Text( \$rdata, 4 ); ( $text, $offset ) = decode Net::DNS::Text( \$rdata, $offset ); my ( $w, $l, $bitmap ) = unpack "\@$offset CCa*", $rdata; is( $w, $rrtype >> 8, "expected window number for $type" ); } foreach my $rrtype ( 0, 7, 8, 15, 16, 23, 24, 31, 32, 39 ) { my $type = typebyval($rrtype); $rr->typelist($type); my $rdata = $rr->rdata; my ( $text, $offset ) = decode Net::DNS::Text( \$rdata, 4 ); ( $text, $offset ) = decode Net::DNS::Text( \$rdata, $offset ); my ( $w, $l, $bitmap ) = unpack "\@$offset CCa*", $rdata; is( $l, 1 + ( $rrtype >> 3 ), "expected map length for $type" ); } foreach my $rrtype ( 0 .. 40, 42 .. 64 ) { my $type = typebyval($rrtype); $rr->typelist($type); my $rdata = $rr->rdata; my ( $text, $offset ) = decode Net::DNS::Text( \$rdata, 4 ); ( $text, $offset ) = decode Net::DNS::Text( \$rdata, $offset ); my ( $w, $l, $bitmap ) = unpack "\@$offset CCa*", $rdata; my $last = unpack 'C', reverse $bitmap; is( $last, ( 0x80 >> ( $rrtype % 8 ) ), "expected map bit for $type" ); } exit; __END__ Net-DNS-1.07/t/21-TSIG-create.t0000644000175000017500000000613313031240164015031 0ustar willemwillem# $Id: 21-TSIG-create.t 1439 2015-12-07 10:37:41Z willem $ -*-perl-*- use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::HMAC Digest::MD5 Digest::SHA MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 11; my $tsig = new Net::DNS::RR( type => 'TSIG' ); my $class = ref($tsig); { my $keyname = 'keyname.example'; my $keytext = 'xdX9m8UtQNbJUzUgQ4xDtUNZAmU='; my $tsig = create $class( $keyname, $keytext ); is( ref($tsig), $class, 'create TSIG from argument list' ); } my $privatekey = 'Khmac-md5.example.+157+53335.private'; END { unlink($privatekey) if defined $privatekey; } open( KEY, ">$privatekey" ) or die "$privatekey $!"; print KEY <<'END'; Private-key-format: v1.2 Algorithm: 157 (HMAC_MD5) Key: ARDJZgtuTDzAWeSGYPAu9uJUkX0= END close KEY; { my $tsig = create $class($privatekey); is( ref($tsig), $class, 'create TSIG from private key' ); } my $publickey = 'Khmac-sha1.example.+161+39562.key'; END { unlink($publickey) if defined $publickey; } open( KEY, ">$publickey" ) or die "$publickey $!"; print KEY <<'END'; HMAC-SHA1.example. IN KEY 512 3 161 xdX9m8UtQNbJUzUgQ4xDtUNZAmU= END close KEY; { my $tsig = create $class($publickey); is( ref($tsig), $class, 'create TSIG from public key' ); } { my $packet = new Net::DNS::Packet('query.example'); $packet->sign_tsig($privatekey); my $tsig = create $class($packet); is( ref($tsig), $class, 'create TSIG from signed packet' ); } { my $chain = eval { create $class($tsig); }; is( ref($chain), $class, 'create successor to existing TSIG' ); } { eval { create $class(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "empty argument list\t[$exception]" ); } { eval { create $class(undef); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "argument undefined\t[$exception]" ); } { my $null = new Net::DNS::RR( type => 'NULL' ); eval { create $class($null); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unexpected argument\t[$exception]" ); } { my $packet = new Net::DNS::Packet('query.example'); eval { create $class($packet); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "no TSIG in packet\t[$exception]" ); } my $badprivatekey = 'K+161+39562.private'; END { unlink($badprivatekey) if defined $badprivatekey; } open( KEY, ">$badprivatekey" ) or die "$badprivatekey $!"; print KEY <<'END'; Private-key-format: v1.2 Algorithm: 161 (HMAC_SHA1) Key: xdX9m8UtQNbJUzUgQ4xDtUNZAmU= END close KEY; { eval { create $class($badprivatekey); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "misnamed private key\t[$exception]" ); } my $dnskey = 'Kbad.example.+161+39562.key'; END { unlink($dnskey) if defined $dnskey; } open( KEY, ">$dnskey" ) or die "$dnskey $!"; print KEY <<'END'; HMAC-SHA1.example. IN DNSKEY 512 3 161 xdX9m8UtQNbJUzUgQ4xDtUNZAmU= END close KEY; { eval { create $class($dnskey); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unrecognised public key\t[$exception]" ); } __END__ Net-DNS-1.07/t/05-DLV.t0000644000175000017500000000322513031240164013450 0ustar willemwillem# $Id: 05-DLV.t 1333 2015-03-03 19:39:52Z willem $ -*-perl-*- use strict; use Test::More tests => 13; use Net::DNS; my $name = 'DLV.example'; my $type = 'DLV'; my $code = 32769; my @attr = qw( keytag algorithm digtype digest ); my @data = ( 42495, 5, 1, '0ffbeba0831b10b8b83440dab81a2148576da9f6' ); my @also = qw( digestbin babble ); my $wire = join '', qw( A5FF 05 01 0FFBEBA0831B10B8B83440DAB81A2148576DA9F6 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name $type"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); $rr->algorithm('RSASHA512'); is( $rr->algorithm(), 10, 'algorithm mnemonic accepted' ); $rr->digtype('SHA256'); is( $rr->digtype(), 2, 'digest type mnemonic accepted' ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-X25.t0000644000175000017500000000354413031240164013405 0ustar willemwillem# $Id: 05-X25.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 11; use Net::DNS; my $name = 'relay.prime.com'; my $type = 'X25'; my $code = 19; my @attr = qw( address ); my @data = qw( 311061700956 ); my @also = qw( PSDNaddress ); my $wire = '0c333131303631373030393536'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-PX.t0000644000175000017500000000454513031240164013360 0ustar willemwillem# $Id: 05-PX.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 17; use Net::DNS; my $name = '*.net2.it'; my $type = 'PX'; my $code = 26; my @attr = qw( preference map822 mapx400 ); my @data = qw( 10 net2.it PRMD-net2.ADMDb.C-it ); my @also = qw( ); my $wire = '000a046e657432026974000950524d442d6e6574320541444d446204432d697400'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-TXT.t0000644000175000017500000000542613031240164013507 0ustar willemwillem# $Id: 05-TXT.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 52; use Net::DNS; my $name = 'TXT.example'; my $type = 'TXT'; my $code = 16; my @attr = qw( txtdata ); my @data = qw( arbitrary_text ); my $wire = '0e6172626974726172795f74657874'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); my @wire = unpack 'C*', $encoded; $wire[length($empty) - 1]--; my $wireformat = pack 'C*', @wire; eval { decode Net::DNS::RR( \$wireformat ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } { foreach my $testcase ( q|contiguous|, q|three unquoted strings|, q|"in quotes"|, q|"two separate" "quoted strings"|, q|"" empty|, q|" " space|, q|!|, q|\"|, q|#|, q|\$|, q|%|, q|&|, q|'|, q|\(|, q|\)|, q|*|, q|+|, q|,|, q|-|, q|.|, q|/|, q|:|, q|\;|, q|<|, q|=|, q|>|, q|?|, q|\@|, q|[|, q|\\\\|, q|]|, q|^|, q|_|, q|`|, q|{|, q(|), q|}|, q|~|, q|0|, q|1|, join( q|\227\128\128|, q|\229\143\164\230\177\160\227\130\132|, q|\232\155\153\233\163\155\232\190\188\227\130\128|, q|\230\176\180\227\129\174\233\159\179| ) ) { my $string = "$name. TXT $testcase"; my $expect = new Net::DNS::RR($string)->string; # test for consistent parsing my $result = new Net::DNS::RR($expect)->string; is( $result, $expect, $string ); } } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-SMIMEA.t0000644000175000017500000000450413031240164013777 0ustar willemwillem# $Id: 05-SMIMEA.t 1449 2016-02-01 12:27:12Z willem $ -*-perl-*- use strict; use Test::More tests => 19; use Net::DNS; my $name = 'c93f1e400f26708f98cb19d936620da35eec8f72e57f9eec01c1afd6._smimecert.example.com'; my $type = 'SMIMEA'; my $code = 53; my @attr = qw( usage selector matchingtype certificate ); my @data = qw( 1 1 1 d2abde240d7cd3ee6b4b28c54df034b97983a1d16e8a410e4561cb106618e971 ); my @also = qw( certbin babble ); my $wire = qw( 010101d2abde240d7cd3ee6b4b28c54df034b97983a1d16e8a410e4561cb106618e971 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ) } { my $rr = new Net::DNS::RR(". $type @data"); eval { $rr->certificate('123456789XBCDEF'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt hexadecimal\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-OPENPGPKEY.t0000644000175000017500000000405213031240164014503 0ustar willemwillem# $Id: 05-OPENPGPKEY.t 1354 2015-06-05 08:20:53Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; my $name = '8d5730bd8d76d417bf974c03f59eedb7af98cb5c3dc73ea8ebbd54b7._openpgpkey.example.com'; my $type = 'OPENPGPKEY'; my $code = 61; my @attr = qw( keys ); my @data = join '', qw( AQPSKmynfzW4kyBv015MUG2DeIQ3Cbl+BBZH4b/0PY1kxkmvHjcZc8nokfzj31GajIQKY+5CptLr 3buXA10hWqTkF7H6RfoRqXQeogmMHfpftf6zMv1LyBUgia7za6ZEzOJBOztyvhjL742iU/TpPSED hm2SNKLijfUppn1UaNvv4w== ); my @also = qw( keysbin ); my $wire = join '', qw( 0103D22A6CA77F35B893206FD35E4C506D8378843709B97E041647E1 BFF43D8D64C649AF1E371973C9E891FCE3DF519A8C840A63EE42A6D2EBDDBB97 035D215AA4E417B1FA45FA11A9741EA2098C1DFA5FB5FEB332FD4BC8152089AE F36BA644CCE2413B3B72BE18CBEF8DA253F4E93D2103866D9234A2E28DF529A6 7D5468DBEFE3 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name NULL"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/31-NSEC-typelist.t0000644000175000017500000000270213031240164015424 0ustar willemwillem# $Id: 31-NSEC-typelist.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; use Net::DNS::Parameters; my @prerequisite = qw( Net::DNS::RR::NSEC; Net::DNS::DomainName; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 79; my $rr = new Net::DNS::RR( type => 'NSEC', nxtdname => 'irrelevant', ); foreach my $rrtype ( 0, 256, 512, 768, 1024 ) { my $type = typebyval($rrtype); $rr->typelist($type); my $rdata = $rr->rdata; my ( $name, $offset ) = decode Net::DNS::DomainName( \$rdata ); my ( $w, $l, $bitmap ) = unpack "\@$offset CCa*", $rdata; is( $w, $rrtype >> 8, "expected window number for $type" ); } foreach my $rrtype ( 0, 7, 8, 15, 16, 23, 24, 31, 32, 39 ) { my $type = typebyval($rrtype); $rr->typelist($type); my $rdata = $rr->rdata; my ( $name, $offset ) = decode Net::DNS::DomainName( \$rdata ); my ( $w, $l, $bitmap ) = unpack "\@$offset CCa*", $rdata; is( $l, 1 + ( $rrtype >> 3 ), "expected map length for $type" ); } foreach my $rrtype ( 0 .. 40, 42 .. 64 ) { my $type = typebyval($rrtype); $rr->typelist($type); my $rdata = $rr->rdata; my ( $name, $offset ) = decode Net::DNS::DomainName( \$rdata ); my ( $w, $l, $bitmap ) = unpack "\@$offset CCa*", $rdata; my $last = unpack 'C', reverse $bitmap; is( $last, ( 0x80 >> ( $rrtype % 8 ) ), "expected map bit for $type" ); } exit; __END__ Net-DNS-1.07/t/70-RRSIG-RSASHA512.t0000644000175000017500000000706413031240164015127 0ustar willemwillem# $Id: 70-RRSIG-RSASHA512.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::RSA Crypt::OpenSSL::Bignum Crypt::OpenSSL::RSA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; RSASHA512.example. IN DNSKEY 257 3 10 ( AwEAAb/7yz0lSf3nFy7MPhkbnqOlaExKlJ8rMmYVEhFYZ5qS/ufQbfQ3stb0opr68eitrauolthm P325OvNxdzSq5rgURjx9ZitDlhxDyPfQhDzY+/CBhY/z++DRIr+v3AN/7kRW8sYwC+2Hoa1+VxQZ 1fSQ4J46ZwoN5slpar9G/Gv5aPgsvweQDI285eQVlIQ9NL00bODOHzoKvh9BAx07MOOcT9q6r9xs MPg6M4C8ykH2zVY5x1iGxT8Syzh/mecSiJtv+b1W4j49pCNj19uenW3oUnyfHg/FBmQpxTiHqs6b 1ZfVH7akvsQqwk12xT0hDEfeyj4jswDiSsEsLqt1DM0= ; Key ID = 39948 ) END ok( $ksk, 'set up RSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; :::::::::::::: Private-key-format: v1.2 Algorithm: 10 (RSASHA512) Modulus: v/vLPSVJ/ecXLsw+GRueo6VoTEqUnysyZhUSEVhnmpL+59Bt9Dey1vSimvrx6K2tq6iW2GY/fbk683F3NKrmuBRGPH1mK0OWHEPI99CEPNj78IGFj/P74NEiv6/cA3/uRFbyxjAL7YehrX5XFBnV9JDgnjpnCg3myWlqv0b8a/lo+Cy/B5AMjbzl5BWUhD00vTRs4M4fOgq+H0EDHTsw45xP2rqv3Gww+DozgLzKQfbNVjnHWIbFPxLLOH+Z5xKIm2/5vVbiPj2kI2PX256dbehSfJ8eD8UGZCnFOIeqzpvVl9UftqS+xCrCTXbFPSEMR97KPiOzAOJKwSwuq3UMzQ== PublicExponent: AQAB PrivateExponent: MnqyZdF4MxqgLd3mNhPdEopbcjPqADALgGvp5EWqeCpOfAWB48UBcSPB3Z4+HUANeiVKBHxeFWCu73PWNDL7l0s9bIpMYvPSdHweS4q4OoeTNxnXVJKCmAplaKGE6CarL6ztCM95U2tmR4gAvXhNmZC+ftw8W5hsJmlheAniNUFaRK28K0+Tlge7XkRxSwK63sjMRHHxAbclr8K2j/GUVkXG9yOrMqgXUJ0WOg9E5BTW+gdkGl4kB5U2gvgRwxkEwY9x7yzrg2cUxrEi9hDlS9HiG5NZizcQqAWkKcdHo28ZB5E4NZBLrKQFjrkOQz3ZjtpUcsTRf/lOvkCOoaveAQ== Prime1: 7lgM8XyKy3IHYC3+GX1bS0LZFqBhUvYuZ52i2dfKoG9XglVKKe0Pmu/Hkgkdc2/mottVdYHpMZ4t/Wt0OXdqfttoYTgIOFTw4t3Jk9HV4aPIRvVD7LRnRQiKEW9OiS9ixplatrlgMqyOIpx3bou6eRzOs1yfBsNSr+LZbHQ50/U= Prime2: zjSQ7ylj386G6bFXMKLAjApYy7cQA9T4/URnonUYjXwzQRaDvfAGoRNRA4e0RagVd/x2Dk5hs2UYLMIhpmQWNoSK/ZAFS02RzapMZTV2jya4cJZ83qjYtMYEx8Lff5dHX3lz/uAkcJCasIbyEodi0btJkCZQFAsCMbGlhguTpnk= Exponent1: U8jEFAfRyp61FQxV7KPyecxv/9I1JDLCMU5qtuVyp188heZxgbeB6tcrcpydq7zEeK9dpUcbsIOIazNg0eq2lw2N7c8CpLrHSxjoCXyUERPADaGeVRE91DiiQGq+Ut9De8jg6KbVuDqMZIJYQZYA4R5NUyPWC0ySPp4iDEv3IBk= Exponent2: tJ867SM2Rs6jQoSCuSl2u7Q8f4UE1DZzO3X1yUoEjbpjMvpDv9ZGGEXRSuRNtk47L/TGfFWQIxHEkUAjNZqqEmsbTGwhFwsFUj9/149zIIVsPcKz8l24JPDnMwuxthOPA0RhpLo1cRxZQ5OQ60YH+2qwT0IgFs5lx52yPa5aURE= Coefficient: Y7KhcJe8vcW9h/bxClHMjlB0sYYvdqo7/iwjxiaCD4suPAUpLMxNgeR3TJHT1RYaHQSuFB3Mc9f58hoHe3dncxF+Eey9SdTH53c0+V95tJpAsqirFaqvei+xgikcmhYsWLOQHayul5ZMsfpiph3R90QUYg3Kpbni4W0ALeGswv4= END close(KSK); my $key = new Net::DNS::RR <<'END'; RSASHA512.example. IN DNSKEY 256 3 10 ( AwEAAdLaxcxvgdQKF3zSOuXQgwWPQ+dKzJ3Ob4w3r+o73i2MnhE0HBHuTzUZGVjGR05VGqZaJx64 LNt0Wlxxoxt3Uwaq55t5MzN3LYYYEcMQ1XPhPG1nNuD0LiqlqL+KmQqlAo3cm4F71gr/GXQiPG3O WM11ulruDKZpyfYg1NWryu3F ; Key ID = 35741 ) END ok( $key, 'set up RSA public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig, 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG over rrset using public ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/07-zonefile.t0000644000175000017500000003276513031240164014653 0ustar willemwillem# $Id: 07-zonefile.t 1510 2016-10-11 12:29:10Z willem $ -*-perl-*- use strict; use FileHandle; use Test::More tests => 91; use constant LIBUTF8 => scalar eval { require Encode; Encode::decode_utf8( chr(91) ) eq '['; # not UTF-EBCDIC [see UTR#16 3.6] }; use constant UTF8 => ref eval { LIBUTF8 && Encode::find_encoding('utf8'); # encoding object }; use constant LIBIDN => UTF8 && defined eval { require Net::LibIDN; }; use constant LIBIDNOK => scalar eval { my $cn = pack( 'U*', 20013, 22269 ); my $xn = 'xn--fiqs8s'; LIBIDN && ( Net::LibIDN::idn_to_ascii( $cn, 'utf-8' ) eq $xn ); }; BEGIN { use_ok('Net::DNS::ZoneFile'); } my $seq; sub source { ## zone file builder my $text = shift; my @args = @_; my $tag = ++$seq; my $file = "zone$tag.txt"; my $handle = new FileHandle( $file, '>' ); # create test file die "Failed to create $file" unless $handle; eval { binmode($handle) }; # suppress encoding layer print $handle $text; close $handle; return new Net::DNS::ZoneFile( $file, @args ); } my $recursive = join ' ', '$INCLUDE', source('$INCLUDE zone1.txt')->name; { eval { new Net::DNS::ZoneFile(undef); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "new(): invalid argument\t[$exception]" ); } { eval { new Net::DNS::ZoneFile( [] ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "new(): not a file handle\t[$exception]" ); } { eval { new Net::DNS::ZoneFile('zone0.txt'); }; # presumed not to exist my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "new(): non-existent file\t[$exception]" ); } { ## public methods my $zonefile = source(''); ok( $zonefile->isa('Net::DNS::ZoneFile'), 'new ZoneFile object' ); ok( defined $zonefile->name, 'zonefile->name always defined' ); ok( defined $zonefile->line, 'zonefile->line always defined' ); ok( defined $zonefile->origin, 'zonefile->origin always defined' ); ok( !defined $zonefile->ttl, 'zonefile->ttl initially undefined' ); my @rr = $zonefile->read; is( scalar(@rr), 0, 'zonefile->read to end of file' ); is( $zonefile->line, 0, 'zonefile->line zero if file empty' ); is( $zonefile->origin, '.', 'zonefile->origin defaults to DNS root' ); } { ## initial origin my $tld = 'test'; my $absolute = source( '', "$tld." ); is( $absolute->origin, "$tld.", 'new ZoneFile with absolute origin' ); my $relative = source( '', "$tld" ); is( $relative->origin, "$tld.", 'new ZoneFile->origin always absolute' ); } { ## line numbering my $lines = 10; my $zonefile = source( "\n" x $lines ); is( $zonefile->line, 0, 'zonefile->line zero before calling read()' ); my @rr = $zonefile->read; is( $zonefile->line, $lines, 'zonefile->line number incremented by read()' ); } { my $zonefile = source <<'EOF'; $TTL EOF eval { $zonefile->read; }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception:\t[$exception]" ); } { my $zonefile = source <<'EOF'; $INCLUDE EOF eval { $zonefile->read; }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception:\t[$exception]" ); } { my $zonefile = source <<'EOF'; $ORIGIN EOF eval { $zonefile->read; }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception:\t[$exception]" ); } { my $zonefile = source <<'EOF'; $GENERATE EOF eval { $zonefile->read; }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception:\t[$exception]" ); } { my $zonefile = source <<'EOF'; $BOGUS EOF eval { $zonefile->read; }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception:\t[$exception]" ); } { ## $TTL directive at start of zone file my $zonefile = source <<'EOF'; $TTL 54321 rr0 SOA mname rname 99 6h 1h 1w 12345 EOF is( $zonefile->read->ttl, 54321, 'SOA TTL set from $TTL directive' ); } { ## no $TTL directive, default implicit my $zonefile = source <<'EOF'; rr0 SOA mname rname 99 6h 1h 1w 0 rr1 NULL EOF is( $zonefile->read->ttl, 0, 'SOA TTL set from zero SOA minimum field' ); is( $zonefile->read->ttl, 0, 'implicit zero default from SOA record' ); } { ## $TTL directive following implicit default my $zonefile = source <<'EOF'; rr0 SOA mname rname 99 6h 1h 1w 12345 rr1 NULL $TTL 54321 rr2 NULL rr3 3h NULL EOF is( $zonefile->read->ttl, 12345, 'SOA TTL set from SOA minimum field' ); is( $zonefile->read->ttl, 12345, 'implicit default from SOA record' ); is( $zonefile->read->ttl, 54321, 'explicit default from $TTL directive' ); is( $zonefile->read->ttl, 10800, 'explicit TTL value overrides default' ); is( $zonefile->ttl, 54321, '$zonefile->ttl set from $TTL directive' ); } { ## $INCLUDE directive my $include = source <<'EOF'; rr2 NULL EOF my $directive = join ' ', '$INCLUDE', $include->name, '.'; my $misdirect = join ' ', '$INCLUDE zone0.txt ; presumed not to exist'; my $zonefile = source <<"EOF"; rr1 NULL $directive rr3 NULL $recursive $misdirect EOF my $fn1 = $zonefile->name; my $rr1 = $zonefile->read; is( $rr1->name, 'rr1', 'zonefile->read expected record' ); is( $zonefile->name, $fn1, 'zonefile->name identifies file' ); is( $zonefile->line, 1, 'zonefile->line identifies record' ); my $fn2 = $include->name; my $rr2 = $zonefile->read; my $sfx = $zonefile->origin; is( $rr2->name, 'rr2', 'zonefile->read expected record' ); is( $zonefile->name, $fn2, 'zonefile->name identifies file' ); is( $zonefile->line, 1, 'zonefile->line identifies record' ); my $rr3 = $zonefile->read; is( $rr3->name, 'rr3', 'zonefile->read expected record' ); is( $zonefile->name, $fn1, 'zonefile->name identifies file' ); is( $zonefile->line, 3, 'zonefile->line identifies record' ); { my @rr = eval { $zonefile->read }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "recursive include\t[$exception]" ); } { my @rr = eval { $zonefile->read }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "non-existent include\t[$exception]" ); } is( $zonefile->name, $fn1, 'zonefile->name identifies file' ); is( $zonefile->line, 5, 'zonefile->line identifies directive' ); } my $zonefile; { ## $ORIGIN directive my $nested = source <<'EOF'; nested NULL EOF my $origin = 'example.com'; my $ORIGIN = '$ORIGIN'; my $inner = join ' ', '$INCLUDE', $nested->name; my $include = source <<"EOF"; $ORIGIN $origin @ NS host $inner @ NULL $ORIGIN relative @ NULL EOF my $outer = join ' ', '$INCLUDE', $include->name; $zonefile = source <<"EOF"; $outer outer NULL $ORIGIN $origin NULL EOF my $ns = $zonefile->read; is( $ns->name, $origin, '@ NS has expected name' ); is( $ns->nsdname, "host.$origin", '@ NS has expected rdata' ); my $rr = $zonefile->read; my $expect = join '.', 'nested', $origin; is( $rr->name, $expect, 'scope of $ORIGIN encompasses nested $INCLUDE' ); is( $zonefile->read->name, $origin, 'scope of $ORIGIN continues after $INCLUDE' ); is( $zonefile->read->name, "relative.$origin", '$ORIGIN can be relative to current $ORIGIN' ); is( $zonefile->read->name, 'outer', 'scope of $ORIGIN curtailed by end of file' ); is( $zonefile->read->name, $origin, 'implicit owner following $ORIGIN directive' ); } { ## $GENERATE directive my $zonefile = source <<'EOF'; $GENERATE 0-0 @ TXT $ $GENERATE 10-30/10 @ TXT $ $GENERATE 30-10/-10 @ TXT $ $GENERATE 123-123 @ TXT ${,,} $GENERATE 123-123 @ TXT ${0,0,d} $GENERATE 123-123 @ TXT ${0,0,o} $GENERATE 123-123 @ TXT ${0,0,x} $GENERATE 123-123 @ TXT ${0,0,X} $GENERATE 123-123 @ TXT ${0,4,X} $GENERATE 123-123 @ TXT ${4096,4,X} $GENERATE 11259375 @ TXT ${0,6,n} $GENERATE 11259375 @ TXT ${0,16,N} $GENERATE 0-0 @ TXT ${0,0,Z} EOF is( $zonefile->read->rdstring, '0', 'generate TXT $' ); is( $zonefile->read->rdstring, '10', 'generate TXT $ with step 10' ); is( $zonefile->read->rdstring, '20', 'generate TXT $ with step 10' ); is( $zonefile->read->rdstring, '30', 'generate TXT $ with step 10' ); is( $zonefile->read->rdstring, '30', 'generate TXT $ with step -10' ); is( $zonefile->read->rdstring, '20', 'generate TXT $ with step -10' ); is( $zonefile->read->rdstring, '10', 'generate TXT $ with step -10' ); is( $zonefile->read->rdstring, '123', 'generate TXT ${,,}' ); is( $zonefile->read->rdstring, '123', 'generate TXT ${0,0,d}' ); is( $zonefile->read->rdstring, '173', 'generate TXT ${0,0,o}' ); is( $zonefile->read->rdstring, '7b', 'generate TXT ${0,0,x}' ); is( $zonefile->read->rdstring, '7B', 'generate TXT ${0,0,X}' ); is( $zonefile->read->rdstring, '007B', 'generate TXT ${0,4,X}' ); is( $zonefile->read->rdstring, '107B', 'generate TXT ${4096,4,X}' ); is( $zonefile->read->rdstring, 'f.e.d.', 'generate TXT ${0,6,n}' ); is( $zonefile->read->rdstring, 'F.E.D.C.B.A.0.0.', 'generate TXT ${0,16,N}' ); eval { $zonefile->read; }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown format:\t[$exception]" ); } { my $zonefile = source <<'EOF'; $TTL 1234 $ORIGIN example. hosta A 192.0.2.1 ; whole line comment ; indented comment ; vvv empty line ; ^^^ empty line ; vvv line with white space ; ^^^ line with white space MX 10 hosta ; end of line comment TXT ( multiline ; interspersed ( mischievously ) resource ; with ( confusing ) record ) ; comments TXT (string) TXT "(string)" EOF is( $zonefile->read->name, 'hosta.example', 'name of simple RR as expected' ); is( $zonefile->read->name, 'hosta.example', 'name of simple RR propagated from previous RR' ); my $multilineRR = $zonefile->read; is( $multilineRR->name, 'hosta.example', 'name of multiline RR propagated from previous RR' ); is( $multilineRR->txtdata, 'multiline resource record', 'multiline RR correctly reassembled' ); my $following = $zonefile->read; is( $following->name, 'hosta.example', 'name of following RR as expected' ); is( $following->txtdata, 'string', 'superfluous brackets ignored' ); is( $zonefile->read->txtdata, '(string)', 'quoted brackets protected' ); } { ## CLASS coersion my $zonefile = source <<'EOF'; rr0 CH NULL rr1 CLASS1 NULL rr2 CLASS2 NULL rr3 CLASS3 NULL EOF my $rr = $zonefile->read; foreach ( $zonefile->read ) { is( $_->class, $rr->class, 'rr->class matches initial record' ); } } { ## compatibility with defunct Net::DNS::ZoneFile 1.04 distro my $listref = Net::DNS::ZoneFile->read( $zonefile->name ); ok( scalar(@$listref), 'read(): entire zone file' ); } { my $listref = Net::DNS::ZoneFile->read( $zonefile->name, '.' ); ok( scalar(@$listref), 'read(): zone file via path' ); } { eval { local $SIG{__WARN__} = sub { }; # presumed not to exist my $listref = Net::DNS::ZoneFile->read( '/zone0.txt', '.' ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "read(): non-existent file\t[$exception]" ); } { eval { local $SIG{__WARN__} = sub { }; # presumed not to exist my $listref = Net::DNS::ZoneFile->read( 'zone0.txt', 't' ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "read(): non-existent file\t[$exception]" ); } { my $listref = Net::DNS::ZoneFile::read( $zonefile->name, '.' ); ok( scalar(@$listref), 'read(): called as subroutine (not object-oriented)' ); } { my $string = ""; my $listref = Net::DNS::ZoneFile->parse( \$string ); is( scalar(@$listref), 0, 'parse(): empty string' ); } { my $string = <<'EOF'; a1.example A 192.0.2.1 a2.example A 192.0.2.2 EOF my $listref = Net::DNS::ZoneFile->parse( \$string ); # this also tests readfh() is( scalar(@$listref), 2, 'parse(): RR string' ); } { my $string = <<'EOF'; a1.example A 192.0.2.1 $BOGUS a2.example A 192.0.2.2 EOF local $SIG{__WARN__} = sub { }; my $listref = Net::DNS::ZoneFile->parse( \$string ); is( $listref, undef, 'parse(): erroneous string' ); } { my $string = <<'EOF'; a1.example A 192.0.2.1 a2.example A 192.0.2.2 EOF my @list = Net::DNS::ZoneFile->parse($string); is( scalar(@list), 2, 'parse(): RR string into array' ); } { my $string = <<'EOF'; a1.example A 192.0.2.1 $BOGUS a2.example A 192.0.2.2 EOF local $SIG{__WARN__} = sub { }; my @list = Net::DNS::ZoneFile->parse($string); is( scalar(@list), 1, 'parse(): erroneous string into array' ); } { my $listref = Net::DNS::ZoneFile::parse('a.example. A 192.0.2.1'); ok( scalar(@$listref), 'parse(): called as subroutine (not object-oriented)' ); } SKIP: { ## Non-ASCII zone content skip( 'Unicode/UTF-8 not supported', 4 ) unless UTF8; my $greek = pack 'C*', 103, 114, 9, 84, 88, 84, 9, 229, 224, 241, 231, 234, 225, 10; my $file1 = source($greek); my $fh1 = new FileHandle( $file1->name, '<:encoding(ISO8859-7)' ); # Greek my $zone1 = new Net::DNS::ZoneFile($fh1); my $txtgr = $zone1->read; my $text = pack 'U*', 949, 944, 961, 951, 954, 945; is( $txtgr->txtdata, $text, 'ISO8859-7 TXT rdata' ); eval { binmode(DATA) }; # suppress encoding layer my $jptxt = ; my $file2 = source($jptxt); my $fh2 = new FileHandle( $file2->name, '<:utf8' ); # UTF-8 character encoding my $zone2 = new Net::DNS::ZoneFile($fh2); my $txtrr = $zone2->read; # TXT RR with kanji RDATA my @rdata = $txtrr->txtdata; my $rdata = $txtrr->txtdata; is( length($rdata), 12, 'Unicode/UTF-8 TXT rdata' ); is( scalar(@rdata), 1, 'Unicode/UTF-8 TXT contiguous' ); skip( 'Non-ASCII domain - Net::LibIDN not available', 1 ) unless LIBIDN; skip( 'Non-ASCII domain - Net::LibIDN not working', 1 ) unless LIBIDNOK; my $kanji = ; my $zone3 = source($kanji); my $nextr = $zone3->read; # NULL RR with kanji owner name is( $nextr->name, 'xn--wgv71a', 'Unicode/UTF-8 domain name' ); } exit; __END__ jp TXT å¤æ± ã‚„　蛙飛込む　水ã®éŸ³ ; Unicode text string 日本 NULL ; Unicode domain name Net-DNS-1.07/t/05-RT.t0000644000175000017500000000451513031240164013353 0ustar willemwillem# $Id: 05-RT.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 16; BEGIN { use_ok('Net::DNS'); } my $name = '*.prime.com'; my $type = 'RT'; my $code = 21; my @attr = qw( preference intermediate ); my @data = qw( 90 relay.prime.com ); my @also = qw( ); my $wire = '005a0572656c6179057072696d6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-AAAA.t0000644000175000017500000001210113031240164013477 0ustar willemwillem# $Id: 05-AAAA.t 1354 2015-06-05 08:20:53Z willem $ -*-perl-*- use strict; use Test::More tests => 136; use Net::DNS; my $name = 'AAAA.example'; my $type = 'AAAA'; my $code = 28; my @attr = qw( address ); my @data = qw( 1:203:405:607:809:a0b:c0d:e0f ); my @also = qw( ); my $wire = '000102030405060708090a0b0c0d0e0f'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my %testcase = ( '0:0:0:0:0:0:0:0' => '::', '0:0:0:0:0:0:0:8' => '::8', '0:0:0:0:0:0:7:0' => '::7:0', '0:0:0:0:0:6:0:0' => '::6:0:0', '0:0:0:0:0:6:0:8' => '::6:0:8', '0:0:0:0:5:0:0:0' => '::5:0:0:0', '0:0:0:0:5:0:0:8' => '::5:0:0:8', '0:0:0:0:5:0:7:0' => '::5:0:7:0', '0:0:0:4:0:0:0:0' => '0:0:0:4::', '0:0:0:4:0:0:0:8' => '::4:0:0:0:8', '0:0:0:4:0:0:7:0' => '::4:0:0:7:0', '0:0:0:4:0:6:0:0' => '::4:0:6:0:0', '0:0:0:4:0:6:0:8' => '::4:0:6:0:8', '0:0:3:0:0:0:0:0' => '0:0:3::', '0:0:3:0:0:0:0:8' => '0:0:3::8', '0:0:3:0:0:0:7:0' => '0:0:3::7:0', '0:0:3:0:0:6:0:0' => '::3:0:0:6:0:0', '0:0:3:0:0:6:0:8' => '::3:0:0:6:0:8', '0:0:3:0:5:0:0:0' => '0:0:3:0:5::', '0:0:3:0:5:0:0:8' => '::3:0:5:0:0:8', '0:0:3:0:5:0:7:0' => '::3:0:5:0:7:0', '0:2:0:0:0:0:0:0' => '0:2::', '0:2:0:0:0:0:0:8' => '0:2::8', '0:2:0:0:0:0:7:0' => '0:2::7:0', '0:2:0:0:0:6:0:0' => '0:2::6:0:0', '0:2:0:0:0:6:0:8' => '0:2::6:0:8', '0:2:0:0:5:0:0:0' => '0:2:0:0:5::', '0:2:0:0:5:0:0:8' => '0:2::5:0:0:8', '0:2:0:0:5:0:7:0' => '0:2::5:0:7:0', '0:2:0:4:0:0:0:0' => '0:2:0:4::', '0:2:0:4:0:0:0:8' => '0:2:0:4::8', '0:2:0:4:0:0:7:0' => '0:2:0:4::7:0', '0:2:0:4:0:6:0:0' => '0:2:0:4:0:6::', '0:2:0:4:0:6:0:8' => '0:2:0:4:0:6:0:8', '1:0:0:0:0:0:0:0' => '1::', '1:0:0:0:0:0:0:8' => '1::8', '1:0:0:0:0:0:7:0' => '1::7:0', '1:0:0:0:0:6:0:0' => '1::6:0:0', '1:0:0:0:0:6:0:8' => '1::6:0:8', '1:0:0:0:5:0:0:0' => '1::5:0:0:0', '1:0:0:0:5:0:0:8' => '1::5:0:0:8', '1:0:0:0:5:0:7:0' => '1::5:0:7:0', '1:0:0:4:0:0:0:0' => '1:0:0:4::', '1:0:0:4:0:0:0:8' => '1:0:0:4::8', '1:0:0:4:0:0:7:0' => '1::4:0:0:7:0', '1:0:0:4:0:6:0:0' => '1::4:0:6:0:0', '1:0:0:4:0:6:0:8' => '1::4:0:6:0:8', '1:0:3:0:0:0:0:0' => '1:0:3::', '1:0:3:0:0:0:0:8' => '1:0:3::8', '1:0:3:0:0:0:7:0' => '1:0:3::7:0', '1:0:3:0:0:6:0:0' => '1:0:3::6:0:0', '1:0:3:0:0:6:0:8' => '1:0:3::6:0:8', '1:0:3:0:5:0:0:0' => '1:0:3:0:5::', '1:0:3:0:5:0:0:8' => '1:0:3:0:5::8', '1:0:3:0:5:0:7:0' => '1:0:3:0:5:0:7:0', ); foreach my $address ( sort keys %testcase ) { my $compact = $testcase{$address}; my $rr1 = new Net::DNS::RR( name => $name, type => $type, address => $address ); is( $rr1->address_short, $compact, "address compression:\t$address" ); my $rr2 = new Net::DNS::RR( name => $name, type => $type, address => $compact ); is( $rr2->address_long, $address, "address expansion:\t$compact" ); } } { my %testcase = ( '1' => '1:0:0:0:0:0:0:0', '1:' => '1:0:0:0:0:0:0:0', '1:2' => '1:2:0:0:0:0:0:0', '1:2:' => '1:2:0:0:0:0:0:0', '1:2:3' => '1:2:3:0:0:0:0:0', '1:2:3:' => '1:2:3:0:0:0:0:0', '1:2:3:4' => '1:2:3:4:0:0:0:0', '1:2:3:4:' => '1:2:3:4:0:0:0:0', '1:2:3:4:5' => '1:2:3:4:5:0:0:0', '1:2:3:4:5:' => '1:2:3:4:5:0:0:0', '1:2:3:4:5:6' => '1:2:3:4:5:6:0:0', '1:2:3:4:5:6:' => '1:2:3:4:5:6:0:0', '1:2:3:4:5:6:7' => '1:2:3:4:5:6:7:0', '1:2:3:4:5:6:7:' => '1:2:3:4:5:6:7:0', '::ffff:1.2.3.4' => '0:0:0:0:0:ffff:102:304', '::ffff:1.2.4' => '0:0:0:0:0:ffff:102:4', '::ffff:1.4' => '0:0:0:0:0:ffff:100:4', ); foreach my $address ( sort keys %testcase ) { my $expect = new Net::DNS::RR( name => $name, type => $type, address => $testcase{$address} ); my $rr = new Net::DNS::RR( name => $name, type => $type, address => $address ); is( $rr->address, $expect->address, "address completion:\t$address" ); } } exit; Net-DNS-1.07/t/05-L64.t0000644000175000017500000000354513031240164013375 0ustar willemwillem# $Id: 05-L64.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 12; use Net::DNS; my $name = 'L64.example'; my $type = 'L64'; my $code = 106; my @attr = qw( preference locator64 ); my @data = qw( 10 2001:db8:1140:1000 ); my @also = qw( ); my $wire = '000a20010db811401000'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-LP.t0000644000175000017500000000463213031240164013341 0ustar willemwillem# $Id: 05-LP.t 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- use strict; use Test::More tests => 17; use Net::DNS; my $name = 'LP.example'; my $type = 'LP'; my $code = 107; my @attr = qw( preference target ); my @data = qw( 10 locator.example.com ); my @also = qw( FQDN fqdn ); my $wire = join '', qw( 000a076c6f6361746f72076578616d706c6503636f6d00 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/08-IPv6.t0000644000175000017500000003771413031240164013624 0ustar willemwillem# $Id: 08-IPv6.t 1523 2016-12-29 16:53:52Z willem $ -*-perl-*- use strict; use Test::More; use t::NonFatal; use Net::DNS; use IO::Select; my $debug = 0; my @hints = qw( 2001:503:ba3e::2:30 2001:500:84::b 2001:500:2::c 2001:500:2d::d 2001:500:a8::e 2001:500:2f::f 2001:500:12::d0d 2001:500:1::53 2001:7fe::53 2001:503:c27::2:30 2001:7fd::1 2001:500:9f::42 2001:dc3::35 ); exit( plan skip_all => 'Online tests disabled.' ) if -e 't/online.disabled'; exit( plan skip_all => 'Online tests disabled.' ) unless -e 't/online.enabled'; exit( plan skip_all => 'IPv6 tests disabled.' ) if -e 't/IPv6.disabled'; exit( plan skip_all => 'IPv6 tests disabled.' ) unless -e 't/IPv6.enabled'; eval { my $resolver = new Net::DNS::Resolver( igntc => 1 ); exit plan skip_all => 'No nameservers' unless $resolver->nameservers; my $reply = $resolver->send(qw(. NS IN)) || die; my @ns = grep $_->type eq 'NS', $reply->answer, $reply->authority; exit plan skip_all => 'Local nameserver broken' unless scalar @ns; 1; } || exit( plan skip_all => 'Non-responding local nameserver' ); eval { my $resolver = new Net::DNS::Resolver( nameservers => [@hints] ); exit plan skip_all => 'No IPv6 transport' unless $resolver->nameservers; my $reply = $resolver->send(qw(. NS IN)) || die; my $from = $reply->answerfrom(); my @ns = grep $_->type eq 'NS', $reply->answer, $reply->authority; exit plan skip_all => "Unexpected response from $from" unless scalar @ns; exit plan skip_all => "Non-authoritative response from $from" unless $reply->header->aa; 1; } || exit( plan skip_all => 'Unable to reach global root nameservers' ); my $IP = eval { my @nsdname = qw(ns.net-dns.org mcvax.nlnet.nl ns.nlnetlabs.nl); my $resolver = new Net::DNS::Resolver(); $resolver->nameservers(@nsdname); $resolver->force_v6(1); my @ip = $resolver->nameservers(); scalar(@ip) ? [@ip] : undef; } || exit( plan skip_all => 'Unable to resolve nameserver name' ); my $NOIP = '::'; diag join( "\n\t", 'will use nameservers', @$IP ) if $debug; Net::DNS::Resolver->debug($debug); plan tests => 86; NonFatalBegin(); { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->send(...) UDP' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->send(...) TCP' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(1); my $udp = $resolver->send(qw(net-dns.org DNSKEY IN)); ok( $udp && $udp->header->tc, '$resolver->send(...) truncated UDP reply' ); $resolver->igntc(0); my $retry = $resolver->send(qw(net-dns.org DNSKEY IN)); ok( $retry && !$retry->header->tc, '$resolver->send(...) automatic TCP retry' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(0); my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->bgsend(...) UDP' ); while ( $resolver->bgbusy($udp) ) { sleep 1; } ok( $resolver->bgisready($udp), '$resolver->bgisready($udp)' ); ok( $resolver->bgread($udp), '$resolver->bgread($udp)' ); $resolver->usevc(1); my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->bgsend(...) TCP' ); while ( $resolver->bgbusy($tcp) ) { sleep 1; } ok( $resolver->bgread($tcp), '$resolver->bgread($tcp)' ); ok( !$resolver->bgbusy(undef), '!$resolver->bgbusy(undef)' ); ok( !$resolver->bgread(undef), '!$resolver->bgread(undef)' ); $resolver->udp_timeout(0); ok( !$resolver->bgread( ref($udp)->new ), '!$resolver->bgread(Socket->new)' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(1); my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); ok( $handle, '$resolver->bgsend(...) truncated UDP' ); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) ignore UDP truncation' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); ok( $handle, '$resolver->bgsend(...) truncated UDP' ); my $packet = $resolver->bgread($handle); ok( $packet && !$packet->header->tc, '$resolver->bgread($tcp) background TCP retry' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); $resolver->nameserver($NOIP); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) background TCP fail' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); my $appendix = ${*$handle}{net_dns_bg}; $$appendix[1]->header->id(undef); # random id my $bgread = $resolver->bgread($handle); ok( !$bgread, '$resolver->bgread($udp) id mismatch' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); delete ${*$handle}{net_dns_bg}; my $bgread = $resolver->bgread($handle); ok( $bgread, '$resolver->bgread($udp) workaround for SpamAssassin' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->persistent_udp(1); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $handle, '$resolver->bgsend(...) persistent UDP' ); my $bgread = $resolver->bgread($handle); ok( $bgread, '$resolver->bgread($udp)' ); my $test = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $test, '$resolver->bgsend(...) persistent UDP' ); is( $test, $handle, 'same UDP socket object used' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->persistent_tcp(1); $resolver->usevc(1); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $handle, '$resolver->bgsend(...) persistent TCP' ); my $bgread = $resolver->bgread($handle); ok( $bgread, '$resolver->bgread($tcp)' ); my $test = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $test, '$resolver->bgsend(...) persistent TCP' ); is( $test, $handle, 'same TCP socket object used' ); close($handle); my $recover = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $recover, 'connection recovered after close' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->srcaddr($NOIP); $resolver->srcport(2345); my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->bgsend(...) specify UDP local address & port' ); $resolver->usevc(1); my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->bgsend(...) specify TCP local address & port' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->srcport(-1); my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$udp, '$resolver->send(...) specify bad UDP source port' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$tcp, '$resolver->send(...) specify bad TCP source port' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->srcport(-1); my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( !$udp, '$resolver->bgsend(...) specify bad UDP source port' ); $resolver->usevc(1); my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( !$tcp, '$resolver->bgsend(...) specify bad TCP source port' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) }; $resolver->igntc(1); my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->send(...) UDP + automatic TSIG' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->send(...) TCP + automatic TSIG' ); my $bgread; foreach my $ip (@$IP) { $resolver->nameserver($ip); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); last if $bgread = $resolver->bgread($handle); } ok( $bgread, '$resolver->bgsend/read TCP + automatic TSIG' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(1); eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' ) }; my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$udp, '$resolver->send(...) UDP + failed TSIG' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$tcp, '$resolver->send(...) TCP + failed TSIG' ); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); my $bgread = $resolver->bgread($handle); ok( !$bgread, '$resolver->bgsend/read TCP + failed TSIG' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->retrans(0); $resolver->retry(0); my @query = ( undef, qw(SOA IN) ); ok( $resolver->query(@query), '$resolver->query( undef, ... ) defaults to "." ' ); ok( $resolver->search(@query), '$resolver->search( undef, ... ) defaults to "." ' ); $resolver->defnames(0); $resolver->dnsrch(0); ok( $resolver->search(@query), '$resolver->search() without dnsrch & defnames' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->searchlist('net'); my @query = (qw(us SOA IN)); ok( $resolver->query(@query), '$resolver->query( name, ... )' ); ok( $resolver->search(@query), '$resolver->search( name, ... )' ); $resolver->defnames(0); $resolver->dnsrch(0); ok( $resolver->query(@query), '$resolver->query() without defnames' ); ok( $resolver->search(@query), '$resolver->search() without dnsrch' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $udp = $resolver->query(qw(bogus.net-dns.org A IN)); ok( !$udp, '$resolver->query() nonexistent name UDP' ); $resolver->usevc(1); my $tcp = $resolver->query(qw(bogus.net-dns.org A IN)); ok( !$tcp, '$resolver->query() nonexistent name TCP' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $update = new Net::DNS::Update(qw(example.com)); ok( $resolver->send($update), '$resolver->send($update) UDP' ); $resolver->usevc(1); ok( $resolver->send($update), '$resolver->send($update) TCP' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP ); $resolver->retrans(0); $resolver->retry(0); $resolver->tcp_timeout(0); my @query = (qw(. SOA IN)); my $query = new Net::DNS::Packet(@query); ok( !$resolver->query(@query), '$resolver->query() failure' ); ok( !$resolver->search(@query), '$resolver->search() failure' ); $query->edns->option( 65001, pack 'x500' ); # pad to force TCP ok( !$resolver->send($query), '$resolver->send() failure' ); ok( !$resolver->bgsend($query), '$resolver->bgsend() failure' ); $resolver->usevc(1); my $update = new Net::DNS::Update('bogus.example.com'); ok( !$resolver->send($update), '$resolver->send() update' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $mx = 'mx2.t.net-dns.org'; my @rr = rr( $resolver, $mx, 'MX' ); is( scalar(@rr), 2, 'Net::DNS::rr() works with specified resolver' ); is( scalar rr( $resolver, $mx, 'MX' ), 2, 'Net::DNS::rr() works in scalar context' ); is( scalar rr( $mx, 'MX' ), 2, 'Net::DNS::rr() works with default resolver' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $mx = 'mx2.t.net-dns.org'; my @mx = mx( $resolver, $mx ); is( scalar(@mx), 2, 'Net::DNS::mx() works with specified resolver' ); # some people seem to use mx() in scalar context is( scalar mx( $resolver, $mx ), 2, 'Net::DNS::mx() works in scalar context' ); is( scalar mx($mx), 2, 'Net::DNS::mx() works with default resolver' ); is( scalar mx('bogus.t.net-dns.org'), 0, "Net::DNS::mx() works for bogus name" ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->tcp_timeout(10); my @zone = $resolver->axfr('net-dns.org'); ok( scalar(@zone), '$resolver->axfr() returns entire zone in list context' ); my @notauth = $resolver->axfr('bogus.net-dns.org'); my $notauth = $resolver->errorstring; ok( !scalar(@notauth), "mismatched zone\t[$notauth]" ); my $iterator = $resolver->axfr('net-dns.org'); ok( ref($iterator), '$resolver->axfr() returns iterator in scalar context' ); my $soa = eval { $iterator->() }; is( ref($soa), 'Net::DNS::RR::SOA', '$iterator->() returns initial SOA RR' ); my $i; eval { return unless $soa; $soa->serial(undef); # force SOA mismatch while ( $iterator->() ) { $i++; } }; my ($exception) = split /\n/, "$@\n"; ok( $i, '$iterator->() iterates through remaining RRs' ); ok( !eval { $iterator->() }, '$iterator->() returns undef after last RR' ); ok( $exception, "iterator exception\t[$exception]" ); my $axfr_start = $resolver->axfr_start('net-dns.org'); ok( $axfr_start, '$resolver->axfr_start() (historical)' ); ok( eval { $resolver->axfr_next() }, '$resolver->axfr_next() works' ); ok( $resolver->answerfrom(), '$resolver->answerfrom() works' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) }; $resolver->tcp_timeout(10); my @zone = $resolver->axfr(); ok( scalar(@zone), '$resolver->axfr() with TSIG verify' ); my @notauth = $resolver->axfr('bogus.net-dns.org'); my $notauth = $resolver->errorstring; ok( !scalar(@notauth), "mismatched zone\t[$notauth]" ); eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' ) }; my @unverifiable = $resolver->axfr(); my $errorstring = $resolver->errorstring; ok( !scalar(@unverifiable), "mismatched key\t[$errorstring]" ); eval { $resolver->tsig(undef) }; my ($exception) = split /\n/, "$@\n"; ok( $exception, "undefined TSIG\t[$exception]" ); $resolver->srcport(-1); my @badsocket = $resolver->axfr(); my $badsocket = $resolver->errorstring; ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP ); eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' ) }; my $query = new Net::DNS::Packet(qw(. SOA IN)); ok( $resolver->bgsend($query), '$resolver->bgsend() + automatic TSIG' ); ok( $resolver->bgsend($query), '$resolver->bgsend() + existing TSIG' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->nameservers(); ok( !$resolver->send(qw(. NS)), 'no nameservers' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->nameserver('cname.t.net-dns.org'); ok( scalar( $resolver->nameservers ), 'resolve nameserver cname' ); } { my $resolver = Net::DNS::Resolver->new(); my @warnings; local $SIG{__WARN__} = sub { push( @warnings, "@_" ); }; my $ns = 'bogus.example.com.'; my @ip = $resolver->nameserver($ns); my ($warning) = split /\n/, "@warnings\n"; ok( $warning, "unresolved nameserver warning\t[$warning]" ) || diag "\tnon-existent '$ns' resolved: @ip"; } { ## exercise exceptions in _axfr_next() my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) }; $resolver->tcp_timeout(10); { my $select = new IO::Select(); eval { $resolver->_axfr_next($select); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "TCP time out\t[$exception]" ); } { my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); my $socket = $resolver->_bgsend_tcp( $packet, $packet->data ); my $select = new IO::Select($socket); while ( $resolver->bgbusy($socket) ) { sleep 1 } my $discarded = ''; ## [size][id][status] [qdcount]... $socket->recv( $discarded, 6 ); eval { $resolver->_axfr_next($select); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt data\t[$exception]" ); } { my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); my $socket = $resolver->_bgsend_tcp( $packet, $packet->data ); my $select = new IO::Select($socket); eval { $resolver->_axfr_next( $select, $packet->sigrr ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "verify fail\t[$exception]" ); } } NonFatalEnd(); exit; __END__ Net-DNS-1.07/t/NonFatal.pm0000644000175000017500000000266113031240164014457 0ustar willemwillem# $Id: NonFatal.pm 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- # Test::More calls functions from Test::Builder. Those functions all eventually # call Test::Builder::ok (on a builder instance) for reporting the status. # Here we define a new builder inherited from Test::Builder, with a redefined # ok method that always reports the test to have completed successfully. # # The functions NonFatalBegin and NonFatalEnd re-bless the builder in use by # Test::More (Test::More->builder) to be of type Test::NonFatal and # Test::Builder respectively. Tests that are between those functions will thus # always appear to succeed. The failure report itself is not suppressed. # # Note that the builder is only re-blessed when the file 't/online.nonfatal' # exists. # # This is just a quick hack to allow for non-fatal unit tests. It has many # problems such as for example that blocks marked by the NonFatalBegin and # NonFatalEnd subroutines may not be nested. # use strict; use Test::More; use constant NONFATAL => eval { -e 't/online.nonfatal' }; { package Test::NonFatal; use base qw(Test::Builder); sub ok { my ( $self, $test, $name ) = ( @_, '' ); $name = "NOT OK, but tolerating failure, $name" unless $test; $self->SUPER::ok( 1, $name ); return $test ? 1 : 0; } } sub NonFatalBegin { bless Test::More->builder, qw(Test::NonFatal) if NONFATAL; } sub NonFatalEnd { bless Test::More->builder, qw(Test::Builder) if NONFATAL; } 1; Net-DNS-1.07/t/05-CDNSKEY.t0000644000175000017500000000402613031240164014123 0ustar willemwillem# $Id: 05-CDNSKEY.t 1354 2015-06-05 08:20:53Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 15; my $name = 'CDNSKEY.example'; my $type = 'CDNSKEY'; my $code = 60; my @attr = qw( flags protocol algorithm publickey ); my @data = ( 256, 3, 5, join '', qw( AQPSKmynfzW4kyBv015MUG2DeIQ3 Cbl+BBZH4b/0PY1kxkmvHjcZc8no kfzj31GajIQKY+5CptLr3buXA10h WqTkF7H6RfoRqXQeogmMHfpftf6z Mv1LyBUgia7za6ZEzOJBOztyvhjL 742iU/TpPSEDhm2SNKLijfUppn1U aNvv4w== ) ); my @also = qw( keybin keylength keytag privatekeyname zone sep ); my $wire = join '', qw( 010003050103D22A6CA77F35B893206FD35E4C506D8378843709B97E041647E1 BFF43D8D64C649AF1E371973C9E891FCE3DF519A8C840A63EE42A6D2EBDDBB97 035D215AA4E417B1FA45FA11A9741EA2098C1DFA5FB5FEB332FD4BC8152089AE F36BA644CCE2413B3B72BE18CBEF8DA253F4E93D2103866D9234A2E28DF529A6 7D5468DBEFE3 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name NULL"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); } exit; Net-DNS-1.07/t/61-SIG0-RSAMD5.t0000644000175000017500000001424713031240164014466 0ustar willemwillem# $Id: 61-SIG0-RSAMD5.t 1385 2015-09-03 06:13:24Z willem $ -*-perl-*- # use strict; use Test::More; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::SIG Net::DNS::SEC Net::DNS::SEC::RSA Crypt::OpenSSL::Bignum Crypt::OpenSSL::RSA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 29; use_ok('Net::DNS::SEC'); my $key = new Net::DNS::RR <<'END'; RSAMD5.example. IN KEY 512 3 1 ( AwEAAcUHtdNvhdBKMkUle+MJ+ntJ148yfsITtZC0g93EguURfU113BQVk6tzgXP/aXs4OptkCgrL sTapAZr5+vQ8jNbLp/uUTqEUzBRMBqi0W78B3aEb7vEsC0FB6VLoCcjylDcKzzWHm4rj1ACN2Zbu 6eT88lDYHTPiGQskw5LGCze7 ; Key ID = 2871 ) END ok( $key, 'set up RSA public key' ); my $keyfile = $key->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KEY, ">$keyfile" ) or die "$keyfile $!"; print KEY <<'END'; Private-key-format: v1.2 Algorithm: 1 (RSA) Modulus: xQe102+F0EoyRSV74wn6e0nXjzJ+whO1kLSD3cSC5RF9TXXcFBWTq3OBc/9pezg6m2QKCsuxNqkBmvn69DyM1sun+5ROoRTMFEwGqLRbvwHdoRvu8SwLQUHpUugJyPKUNwrPNYebiuPUAI3Zlu7p5PzyUNgdM+IZCyTDksYLN7s= PublicExponent: AQAB PrivateExponent: yOATgH0y8Ci1F8ofhFmoBgpCurvAgB2X/vALgQ3YZbJvDYob1l4pL6OTV7AO2pF5LvPPSTJielfUSyyRrnANJSST/Dr19DgpSpnY2GWE7xmJ6/QqnIaJ2+10pFzVRXShijJZjt9dY7JXmNIoQ+JseE08aquKHFEGVfsvkThk8Q== Prime1: 9lyWnGhbZZwVQo/qNHjVeWEDyc0hsc/ynT4Qp/AjVhROY+eJnBEvhtmqj3sq2gDQm2ZfT8uubSH5ZkNrnJjL2Q== Prime2: zL0L5kwZXqUyRiPqZgbhFEib210WZne+AI88iyi39tU/Iplx1Q6DhHmOuPhUgCCj2nqQhWs9BAkQwemLylfHsw== Exponent1: rcETgHChtYJmBDIYTrXCaf8get2wnAY76ObzPF7DrVxZBWExzt7YFFXEU7ncuTDF8DQ9mLvg45uImLWIWkPx0Q== Exponent2: qtb8vPi3GrDCGKETkHshCank09EDRhGY7CKZpI0fpMogWqCrydrIh5xfKZ2d9SRHVaF8QrhPO7TM1OIqkXdZ3Q== Coefficient: IUxSSCxp+TotMTbloOt/aTtxlaz0b5tSS7dBoLa7//tmHZvHQjftEw8KbXC89QhHd537YZX4VcK/uYbU6SesRA== END close(KEY); my $bad1 = new Net::DNS::RR <<'END'; RSAMD5.example. IN KEY 512 3 1 ( AwEAAdDembFMoX8rZTqTjHT8PbCZHbTJpDgtuL0uXpJqPZ6ZKnGdQsXVn4BSs8VJlH7+NEv+7Spq Ncxjx6o86HhrvFg5DsDMhEi5MIqlt1OcUYa0zUhFSkb+yzOSnPL7doSoaW8pxoX4uDemkfyOY9xN tNCNBJcvmp1Uvdnttf7LUorD ; Key ID = 21130 ) END my $bad2 = new Net::DNS::RR <<'END'; RSASHA1.example. IN KEY ( 512 3 5 AwEAAcosvYOe384kf7szGV4YxwfliKk9VTlO8HEQnlQs4glpMwtwCm8E9zxQRMG1W9CsM7tcHKq8 52KcapenPMkYCseeI7sRtD4k5eF6Us7SaYNRYG6qBhXkSRr41aTroqq+I9IMgAGMzUpC2a9rzn+f Hs5pZA2CKzoR1+9Jv4vKu5MF ; Key ID = 16351 ) END { my $packet = new Net::DNS::Packet('example'); $packet->sign_sig0($keyfile); $packet->data; ok( $packet->sigrr->sigbin, 'sign packet using private key' ); my $verified = $packet->verify($key); ok( $verified, 'verify packet using public key' ); is( $packet->verifyerr, '', 'observe no packet->verifyerr' ); } { my $packet = new Net::DNS::Packet('example'); $packet->sign_sig0($keyfile); my $buffer = $packet->data; my $decoded = new Net::DNS::Packet( \$buffer ); my $verified = $decoded->verify($key); ok( $verified, 'verify decoded packet using public key' ); is( $decoded->verifyerr, '', 'observe no packet->verifyerr' ); } { my $packet = new Net::DNS::Packet('example'); $packet->sign_sig0($keyfile); $packet->data; my $verified = $packet->verify($bad1); ok( !$verified, 'verify fails using wrong key' ); ok( $packet->verifyerr, 'observe packet->verifyerr' ); } { my $packet = new Net::DNS::Packet('example'); $packet->sign_sig0($keyfile); $packet->data; my $verified = $packet->verify($bad2); ok( !$verified, 'verify fails using wrong key' ); ok( $packet->verifyerr, 'observe packet->verifyerr' ); } { my $packet = new Net::DNS::Packet('example'); $packet->sign_sig0($keyfile); $packet->data; $packet->push( answer => rr_add('bogus. A 10.1.2.3') ); my $verified = $packet->verify($key); ok( !$verified, 'verify fails for modified packet' ); ok( $packet->verifyerr, 'observe packet->verifyerr' ); } { my $packet = new Net::DNS::Packet('example'); $packet->sign_sig0($keyfile); $packet->data; my $verified = $packet->verify( [$bad1, $bad2, $key] ); ok( $verified, 'verify packet using array of keys' ); is( $packet->verifyerr, '', 'observe no packet->verifyerr' ); } { my $packet = new Net::DNS::Packet('example'); $packet->sign_sig0($keyfile); $packet->data; $packet->push( answer => rr_add('bogus. A 10.1.2.3') ); my $verified = $packet->verify( [$bad1, $bad2, $key] ); ok( !$verified, 'verify failure using array of keys' ); ok( $packet->verifyerr, 'observe packet->verifyerr' ); } { my $data = new Net::DNS::Packet('example')->data; my $sig = create Net::DNS::RR::SIG( $data, $keyfile ); ok( $sig->sigbin, 'create SIG over data using private key' ); my $verified = $sig->verify( $data, $key ); ok( $verified, 'verify data using public key' ); is( $sig->vrfyerrstr, '', 'observe no sig->vrfyerrstr' ); } { my $data = new Net::DNS::Packet('example')->data; my $time = time() + 3; my %args = ( siginception => $time, sigexpiration => $time, ); my $object = create Net::DNS::RR::SIG( $data, $keyfile, %args ); ok( !$object->verify( $data, $key ), 'verify fails for postdated SIG' ); ok( $object->vrfyerrstr, 'observe sig->vrfyerrstr' ); sleep 1 until $time < time(); ok( !$object->verify( $data, $key ), 'verify fails for expired SIG' ); ok( $object->vrfyerrstr, 'observe sig->vrfyerrstr' ); } { my $object = new Net::DNS::RR( type => 'SIG' ); my $keyrec = new Net::DNS::RR( type => 'KEY' ); my $nonkey = new Net::DNS::RR( type => 'DS' ); my $packet = new Net::DNS::Packet(); my $array = []; my @testcase = ( ## test verify() with invalid arguments [$array, $keyrec], [$object, $keyrec], [$packet, $keyrec], [$packet, $nonkey], ); foreach my $arglist (@testcase) { my @argtype = map ref($_), @$arglist; $object->typecovered('A'); # induce failure eval { $object->verify(@$arglist); }; my $exception = $1 if $@ =~ /^(.*)\n*/; ok( defined $exception, "verify(@argtype)\t[$exception]" ); } } { my $packet = new Net::DNS::Packet('query.example'); $packet->sign_sig0($keyfile); my $signed = $packet->data; # signing occurs in SIG->encode $packet->sigrr->sigbin(''); # signature destroyed my $unsigned = $packet->data; # unable to regenerate SIG0 ok( length($unsigned) < length($signed), 'handled exception: missing key reference' ); } exit; __END__ Net-DNS-1.07/t/01-resolver-opt.t0000644000175000017500000000474113031240164015464 0ustar willemwillem# $Id: 01-resolver-opt.t 1444 2016-01-05 10:01:10Z willem $ -*-perl-*- use strict; use Test::More tests => 37; use File::Spec; use Net::DNS; # .txt because this test will run under windows, unlike the other file # configuration tests. my $test_file = File::Spec->catfile( 't', 'custom.txt' ); # redefines default config my $object = new Net::DNS::Resolver( config_file => $test_file ); ok( $object->isa('Net::DNS::Resolver'), 'new() created object' ); my $no_file = File::Spec->catfile( 't', 'nonexist.txt' ); eval { new Net::DNS::Resolver( config_file => $no_file ); }; # presumed not to exist my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "new(): non-existent file\t[$exception]" ); my $res = new Net::DNS::Resolver( config_file => $test_file ); my @servers = $res->nameservers; is( $servers[0], '10.0.1.42', 'nameserver list correct' ); is( $servers[1], '10.0.2.42', 'nameserver list correct' ); my @search = $res->searchlist; is( $search[0], 'alt.net-dns.org', 'searchlist correct' ); is( $search[1], 'ext.net-dns.org', 'searchlist correct' ); is( $res->domain, 'alt.net-dns.org', 'domain correct' ); # # Check that we can set things in new() # my %test_config = ( domain => 'net-dns.org', searchlist => ['net-dns.org', 't.net-dns.org'], nameservers => ['10.0.0.1', '10.0.0.2'], debug => 1, defnames => 0, dnsrch => 0, recurse => 0, retrans => 6, retry => 5, persistent_tcp => 1, persistent_udp => 1, tcp_timeout => 60, udp_timeout => 60, usevc => 1, port => 54, srcport => 53, adflag => 1, cdflag => 0, dnssec => 0, ); foreach my $key ( sort keys %test_config ) { my $resolver = Net::DNS::Resolver->new( $key => $test_config{$key} ); my @returned = $resolver->$key; my %returned = ( $key => scalar(@returned) > 1 ? [@returned] : shift(@returned) ); is_deeply( $returned{$key}, $test_config{$key}, "$key is correct" ); } # # Check that new() is vetting things properly. # foreach my $test (qw(nameservers searchlist)) { foreach my $input ( {}, \1 ) { my $res = eval { Net::DNS::Resolver->new( $test => $input ); }; ok( $@, 'Invalid input caught' ); ok( !$res, 'No resolver returned' ); } } my %bad_input = ( errorstring => 'set', answerfrom => 'set', answersize => 'set', ); while ( my ( $key, $value ) = each %bad_input ) { my $res = Net::DNS::Resolver->new( $key => $value ); isnt( $res->{$key}, 'set', "$key is not set" ); } exit; Net-DNS-1.07/t/02-domain.t0000644000175000017500000001746613031240164014303 0ustar willemwillem# $Id: 02-domain.t 1404 2015-09-22 13:38:04Z willem $ -*-perl-*- use strict; use Test::More tests => 62; use constant LIBUTF8 => scalar eval { require Encode; Encode::decode_utf8( chr(91) ) eq '['; # not UTF-EBCDIC [see UTR#16 3.6] }; use constant UTF8 => ref eval { LIBUTF8 && Encode::find_encoding('utf8'); # encoding object }; use constant LIBIDN => UTF8 && defined eval { require Net::LibIDN; }; use constant LIBIDNOK => scalar eval { my $cn = pack( 'U*', 20013, 22269 ); my $xn = 'xn--fiqs8s'; LIBIDN && ( Net::LibIDN::idn_to_ascii( $cn, 'utf-8' ) eq $xn ); }; use_ok('Net::DNS::Domain'); { my $name = 'example.com'; my $domain = new Net::DNS::Domain($name); ok( $domain->isa('Net::DNS::Domain'), 'object returned by new() constructor' ); my $same = new Net::DNS::Domain($name); is( $same, $domain, "same name returns cached object" ); my %cache; my ( $i, $j ); for ( ; ; ) { $j = ( $i++ >> 1 ) + 1; my $fill = "name-$i"; my $test = "name-$j"; $cache{$fill} = new Net::DNS::Domain($fill); last unless $cache{$test} == new Net::DNS::Domain($test); } my $size = $i - $j; ok( $size, "name cache at least $size deep" ); } { my $domain = eval { new Net::DNS::Domain(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "empty argument list\t[$exception]" ); } { my $domain = eval { new Net::DNS::Domain(undef); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "argument undefined\t[$exception]" ); } { my $domain = new Net::DNS::Domain('name'); is( $domain->name, 'name', '$domain->name() without trailing dot' ); is( $domain->fqdn, 'name.', '$domain->fqdn() with trailing dot' ); is( $domain->string, 'name.', '$domain->string() with trailing dot' ); } { my $root = new Net::DNS::Domain('.'); is( $root->name, '.', '$root->name() represented by single dot' ); is( $root->fqdn, '.', '$root->fqdn() represented by single dot' ); is( $root->xname, '.', '$root->xname() represented by single dot' ); is( $root->string, '.', '$root->string() represented by single dot' ); } { my $domain = new Net::DNS::Domain('example.com'); my $labels = @{[$domain->label]}; is( $labels, 2, 'domain labels separated by dots' ); } use constant ESC => '\\'; { my $case = ESC . '.'; my $domain = new Net::DNS::Domain("example${case}com"); my $labels = @{[$domain->label]}; is( $labels, 1, "$case devoid of special meaning" ); } { my $case = ESC . ESC; my $domain = new Net::DNS::Domain("example${case}.com"); my $labels = @{[$domain->label]}; is( $labels, 2, "$case devoid of special meaning" ); } { my $case = ESC . ESC . ESC . '.'; my $domain = new Net::DNS::Domain("example${case}com"); my $labels = @{[$domain->label]}; is( $labels, 1, "$case devoid of special meaning" ); } { my $case = '\092'; my $domain = new Net::DNS::Domain("example${case}.com"); my $labels = @{[$domain->label]}; is( $labels, 2, "$case devoid of special meaning" ); } { my $name = 'simple-name'; my $simple = new Net::DNS::Domain($name); is( $simple->name, $name, "$name absolute by default" ); my $create = origin Net::DNS::Domain(undef); my $domain = &$create( sub { new Net::DNS::Domain($name); } ); is( $domain->name, $name, "$name absolute if origin undefined" ); } { my $name = 'simple-name'; my $create = origin Net::DNS::Domain('.'); my $domain = &$create( sub { new Net::DNS::Domain($name); } ); is( $domain->name, $name, "$name absolute if origin '.'" ); my @label = $domain->label; is( scalar(@label), 1, "$name has single label" ); } { my $name = 'simple-name'; my $suffix = 'example.com'; my $create = origin Net::DNS::Domain($suffix); my $domain = &$create( sub { new Net::DNS::Domain($name); } ); my $expect = new Net::DNS::Domain("$name.$suffix"); is( $domain->name, $expect->name, "origin appended to $name" ); my $root = new Net::DNS::Domain('@'); is( $root->name, '.', 'bare @ represents root by default' ); my $origin = &$create( sub { new Net::DNS::Domain('@'); } ); is( $origin->name, $suffix, 'bare @ represents defined origin' ); } { foreach my $char (qw($ ' " ; @)) { my $name = $char . 'example.com.'; my $domain = new Net::DNS::Domain($name); is( $domain->string, ESC . $name, "escape leading $char in string" ); } } { foreach my $part (qw(_rvp._tcp *)) { my $name = "$part.example.com."; my $domain = new Net::DNS::Domain($name); is( $domain->string, $name, "permit leading $part" ); } } { my $ldh = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-0123456789'; my $domain = new Net::DNS::Domain($ldh); is( $domain->name, $ldh, '63 octet LDH character label' ); } { my @warnings; local $SIG{__WARN__} = sub { push( @warnings, "@_" ); }; my $name = 'LO-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-NG!'; my $domain = new Net::DNS::Domain("$name"); my ($warning) = @warnings; chomp $warning; ok( $warning, "long domain label\t[$warning]" ); } { my $domain = eval { new Net::DNS::Domain('.example.com') }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "empty initial label\t[$exception]" ); } { my $domain = eval { new Net::DNS::Domain("example..com"); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "empty interior label\t[$exception]" ); } { my $name = 'example.com'; my $domain = new Net::DNS::Domain("$name..."); is( $domain->name, $name, 'ignore gratuitous trailing dots' ); } SKIP: { skip( 'IDN test - Unicode/UTF-8 not supported', 9 ) unless UTF8; skip( 'IDN test - Net::LibIDN not installed', 9 ) unless LIBIDN; skip( 'IDN test - Net::LibIDN not working', 9 ) unless LIBIDNOK; my $a_label = 'xn--fiqs8s'; my $u_label = eval { pack( 'U*', 20013, 22269 ); }; is( new Net::DNS::Domain($a_label)->name, $a_label, 'IDN A-label domain->name' ); is( new Net::DNS::Domain($a_label)->fqdn, "$a_label.", 'IDN A-label domain->fqdn' ); is( new Net::DNS::Domain($a_label)->xname, $u_label, 'IDN A-label domain->xname' ); is( new Net::DNS::Domain($a_label)->string, "$a_label.", 'IDN A-label domain->string' ); is( new Net::DNS::Domain($u_label)->name, $a_label, 'IDN U-label domain->name' ); is( new Net::DNS::Domain($u_label)->fqdn, "$a_label.", 'IDN U-label domain->fqdn' ); is( new Net::DNS::Domain($u_label)->xname, $u_label, 'IDN U-label domain->xname' ); new Net::DNS::Domain($u_label)->xname; # exercise cache path is( new Net::DNS::Domain($u_label)->string, "$a_label.", 'IDN U-label domain->string' ); eval { new Net::DNS::Domain( pack 'H*', 'C200' ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "invalid name\t[$exception]" ); } { foreach my $case ( '\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015', '\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031' ) { my $domain = new Net::DNS::Domain($case); is( $domain->name, $case, "C0 controls:\t$case" ); } } { foreach my $case ( '\032!"#$%&\'()*+,-\./', # 32 .. 47 '0123456789:;<=>?', # 48 .. '@ABCDEFGHIJKLMNO', # 64 .. 'PQRSTUVWXYZ[\\\\]^_', # 80 .. '`abcdefghijklmno', # 96 .. 'pqrstuvwxyz{|}~\127' # 112 .. ) { my $domain = new Net::DNS::Domain($case); is( $domain->name, $case, "G0 graphics:\t$case" ); } } { foreach my $case ( '\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143', '\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159', '\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175', '\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191', '\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207', '\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223', '\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239', '\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255' ) { my $domain = new Net::DNS::Domain($case); is( $domain->name, $case, "8-bit codes:\t$case" ); } } exit; Net-DNS-1.07/t/73-RRSIG-ECDSAP256SHA256.t0000644000175000017500000000326613031240164015706 0ustar willemwillem# $Id: 73-RRSIG-ECDSAP256SHA256.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::ECDSA Crypt::OpenSSL::Bignum Crypt::OpenSSL::EC Crypt::OpenSSL::ECDSA Digest::SHA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; ECDSAP256SHA256.example. IN DNSKEY 257 3 13 ( z72glzDFUwYbpcruyKn+qYSbBGDymZJBt0wSFpY05RfuG32tqSqesr98/mt8i7fa4faC8UvmL2zj kOsTo3t2og== ; Key ID = 26512 ) END ok( $ksk, 'set up ECDSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.2 Algorithm: 13 (ECDSAP256SHA256) PrivateKey: h/mc+iq9VDUbNAjQgi8S8JzlEX29IALchwJmNM3QYKk= END close(KSK); my $key = new Net::DNS::RR <<'END'; ECDSAP256SHA256.example. IN DNSKEY 256 3 13 ( ZVcqO8GnPFjjqXLRN8CiH1Cwx2n9s9Eg1NVXZunT5kkfwd7b7GlaliMcCPw+tZkTZNMdm8ge5Q71 8UIKvGZMNw== ; Key ID = 24312 ) END ok( $key, 'set up ECDSA public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig, 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG using ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/05-MINFO.t0000644000175000017500000000453413031240164013677 0ustar willemwillem# $Id: 05-MINFO.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 15; use Net::DNS; my $name = 'MINFO.example'; my $type = 'MINFO'; my $code = 14; my @attr = qw( rmailbx emailbx ); my @data = qw( rp@example.com rp@example.net ); my @also = qw( ); my $wire = '027270076578616d706c6503636f6d00027270076578616d706c65036e657400'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed < length $predecessor, 'encoded RDATA compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-A.t0000644000175000017500000000401313031240164013177 0ustar willemwillem# $Id: 05-A.t 1028 2012-10-23 20:18:49Z willem $ -*-perl-*- use strict; use Test::More tests => 12; use Net::DNS; my $name = 'A.example'; my $type = 'A'; my $code = 1; my @attr = qw( address ); my @data = qw( 192.0.2.1 ); my @also = qw( ); my $wire = 'c0000201'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my %testcase = ( '1.2.3.4' => '1.2.3.4', '1.2.4' => '1.2.0.4', '1.4' => '1.0.0.4', ); foreach my $address ( sort keys %testcase ) { my $expect = $testcase{$address}; my $rr = new Net::DNS::RR( name => $name, type => $type, address => $address ); is( $rr->address, $expect, "address completion:\t$address" ); } } exit; Net-DNS-1.07/t/67-RRSIG-NSEC3RSASHA1.t0000644000175000017500000000703713031240164015522 0ustar willemwillem# $Id: 67-RRSIG-NSEC3RSASHA1.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::RSA Crypt::OpenSSL::Bignum Crypt::OpenSSL::RSA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; NSEC3RSASHA1.example. IN DNSKEY 257 3 7 ( AwEAAbHJTox3ouUUnzmoD+0QIf0BKjr9N2eVxhozx/LBIdVO3GdCcsXD0M7zwfkPB9FvU1LIdgGm b8I4VVildoBttlRoXsoTHHf0a2fab0WYpJ4HQGlS6BaQh+Rhbtbc7yGf9HOa+sTa2OpGeqy+vYWO Egvi6do0zrzYVzXsXZrZj/Q+cZP9j//uY/CoLLOBSYHNE+Fd8D4BMLp4Uh74l7I/yVqQBYy24riY X3TKwrfrNRcQ6/GFjNezAZjLo3Vlm1jjhmWqNLsOeMp04nIbkDMYdnJ2dCseBDYm45fS86ggTxhG A60vzcaBRvi5dxpCq39yjdgTq/RAzmcPS35wpZprxss= ; Key ID = 27099 ) END ok( $ksk, 'set up RSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.2 Algorithm: 7 (NSEC3RSASHA1) Modulus: sclOjHei5RSfOagP7RAh/QEqOv03Z5XGGjPH8sEh1U7cZ0JyxcPQzvPB+Q8H0W9TUsh2AaZvwjhVWKV2gG22VGheyhMcd/RrZ9pvRZikngdAaVLoFpCH5GFu1tzvIZ/0c5r6xNrY6kZ6rL69hY4SC+Lp2jTOvNhXNexdmtmP9D5xk/2P/+5j8Kgss4FJgc0T4V3wPgEwunhSHviXsj/JWpAFjLbiuJhfdMrCt+s1FxDr8YWM17MBmMujdWWbWOOGZao0uw54ynTichuQMxh2cnZ0Kx4ENibjl9LzqCBPGEYDrS/NxoFG+Ll3GkKrf3KN2BOr9EDOZw9LfnClmmvGyw== PublicExponent: AQAB PrivateExponent: OU9ROMqgAgSBx047xAl9S1eCy30wzP1k3LFwdPp484/2UHsFEGcs+mltT+HefU7Lp1XjZGjIge0y5d6AsqmrKs5yL+W1OZ3auaGaWO75sc9YnhsRoaR5ic82saCKnWY4oMOGrsp1Ph/2D5V09oZzns1I4QRA2HNMuZ82FWKomuy0iR4vR87macOuOB4erhZeSuEO/5EHXh6rDlWKoBCcIYBr4bjGQ4IsYyFVvBPUaEMX3NO0ahHFHM3QeEvVNyplUhNpODSd1bRK1mZoiGSTv7fJ/UygC2OJsoBzpAVqeTKJKBJWBU3Jp3Alg7IOOnaIdeapa/doCcEURuWVZx9LgQ== Prime1: 2+e0aqqdaF8rXG9X1aH6ho8ZmrwHReHQin0Bylc6YOmNlvQfIMifAxfs/MQZsdcR8wsIH/GW5pWBruBd6yNRF73QDITW0/O0f9Rk738TMEmUQw9cRhq2dNoKhpT44r7kiH9n7HJDBjT9vzle5/fWMlCmzFLUGGFt/DJNH03Kdms= Prime2: zvfLgQQyoxm9Fh2TKIw4rQ4HCzfdFwm7X0MlvBrIL8cDxb7N5mJcSqF7AMFEssZW8h2IunSQZcXEkmDfGYZakD2L1hs+xMcFZsa0b2wyfvCjcxavIz3ucbjJ4OQG/XbQkpU/mkZbyNUQaPH7ILWHI+c2+19lolpYEc/oub4qSSE= Exponent1: FYS13d42KvltF815bdk815/3JHIT0B3Jt1OGMlOYzdTs2wGmbiHTlYzozs8tqH5gLkU9FUshtgyZNRCVgCXjkIwtaJwzHWhymDOjcOAhc48vp+Q/5khE5GhVsVewhxeg6050T+nabygOUID/rXlOB3xm5gWQ5ZXbGludult1XWM= Exponent2: udGQTI1QSU9ajPiQnt8GI5lsiY3mWkDKkYTf5DrHcN3lbS0Z/7Zf1kGVBeB/pWKdvVL25zCwVC9zhVij9W7C8K3RVrGvcUyedOACL+ecjovOtA2xwJph8ohN+DPCct6x9Gk7aW+yCGYDDbX0GjHg20NEAfxsa49hctyPvfQWUwE= Coefficient: iqzKS1qZPOmFj/ZlZSEyLDDoXNfXg1KwTqPAYWM+2Ppq15U0kb+SUidI8pWisatryznRTcdfkYbkcZqcUq1Xkg0DyUVLo80ld9iTTxyc/gPFvEfs8eubDYlC3ZQEaWRb+JQ6jY+NWJnjTqegEGymY/4KTD4WIM7WnIBbNxzrsS8= END close(KSK); my $key = new Net::DNS::RR <<'END'; NSEC3RSASHA1.example. IN DNSKEY 256 3 7 ( AwEAAcNz+cEA/Zkl/8u5/kfJKPNSbmXbdMpk6jM4bMWTEhZlaEOJE+GYsbM+HvjMgEMz00eDpvDR XEMl1o4x60SgW8ap44deky/KAYzDC80rIZrvjDx8DPzF3yIikrGc8P7Eq+0zbWrYyiHRg5DllIT4 5NCz6EMtji1RQloWCaXuAzCN ; Key ID = 23540 ) END ok( $key, 'set up RSA public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig, 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG over rrset using public ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/00-pod.t0000644000175000017500000000061613031240164013601 0ustar willemwillem# $Id: 00-pod.t 1381 2015-08-25 07:36:09Z willem $ # use strict; use Test::More; my %prerequisite = qw( Test::Pod 1.45 ); while ( my ( $package, $rev ) = each %prerequisite ) { eval "use $package $rev"; next unless $@; plan skip_all => "$package $rev required for testing POD"; exit; } my @poddirs = qw( blib demo ); my @allpods = all_pod_files(@poddirs); all_pod_files_ok(@allpods); Net-DNS-1.07/t/05-CNAME.t0000644000175000017500000000443113031240164013646 0ustar willemwillem# $Id: 05-CNAME.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 13; use Net::DNS; my $name = 'CNAME.example'; my $type = 'CNAME'; my $code = 5; my @attr = qw( cname ); my @data = qw( example.com ); my @also = qw( ); my $wire = '076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed < length $predecessor, 'encoded RDATA compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-EUI48.t0000644000175000017500000000332113031240164013616 0ustar willemwillem# $Id: 05-EUI48.t 1139 2013-12-11 09:57:34Z willem $ -*-perl-*- use strict; use Test::More tests => 9; use Net::DNS; my $name = 'EUI48.example'; my $type = 'EUI48'; my $code = 108; my @attr = qw( address ); my @data = qw( 5e-ef-10-00-00-2a ); my @also = qw( ); my $wire = '5eef1000002a'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } exit; Net-DNS-1.07/t/05-EUI64.t0000644000175000017500000000333313031240164013617 0ustar willemwillem# $Id: 05-EUI64.t 1139 2013-12-11 09:57:34Z willem $ -*-perl-*- use strict; use Test::More tests => 9; use Net::DNS; my $name = 'EUI64.example'; my $type = 'EUI64'; my $code = 109; my @attr = qw( address ); my @data = qw( 00-00-5e-ef-10-00-00-2a ); my @also = qw( ); my $wire = '00005eef1000002a'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } exit; Net-DNS-1.07/t/41-DNSKEY-keytag.t0000644000175000017500000000223313031240164015300 0ustar willemwillem# $Id: 41-DNSKEY-keytag.t 1352 2015-06-02 08:13:13Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Net::DNS::RR::DNSKEY; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 4; my $key = new Net::DNS::RR <<'END'; RSASHA1.example. IN DNSKEY 256 3 5 ( AwEAAZHbngk6sMoFHN8fsYY6bmGR4B9UYJIqDp+mORLEH53Xg0f6RMDtfx+H3/x7bHTUikTr26bV AqsxOs2KxyJ2Xx9RGG0DB9O4gpANljtTq2tLjvaQknhJpSq9vj4CqUtr6Wu152J2aQYITBoQLHDV i8mIIunparIKDmhy8TclVXg9 ; Key ID = 1623 ) END ok( $key, 'set up DNSKEY record' ); my $keytag = $key->keytag; is( $keytag, 1623, 'numerical keytag has expected value' ); my $newkey = <<'END'; AwEAAcNz+cEA/Zkl/8u5/kfJKPNSbmXbdMpk6jM4bMWTEhZlaEOJE+GYsbM+HvjMgEMz00eDpvDR XEMl1o4x60SgW8ap44deky/KAYzDC80rIZrvjDx8DPzF3yIikrGc8P7Eq+0zbWrYyiHRg5DllIT4 5NCz6EMtji1RQloWCaXuAzCN END my $keybin = $key->keybin; $key->key($newkey); isnt( $key->keytag, $keytag, 'keytag recalculated from modified key' ); $key->keybin($keybin); is( $key->keytag, $keytag, 'keytag recalculated from restored key' ); exit; __END__ Net-DNS-1.07/t/02-domainname.t0000644000175000017500000001733713031240164015141 0ustar willemwillem# $Id: 02-domainname.t 1355 2015-06-05 08:23:04Z willem $ -*-perl-*- use strict; use Test::More tests => 51; BEGIN { use_ok('Net::DNS::DomainName'); } { my $domain = new Net::DNS::DomainName(''); is( $domain->name, '.', 'DNS root represented as single dot' ); my @label = $domain->_wire; is( scalar(@label), 0, "DNS root name has zero labels" ); my $binary = unpack 'H*', $domain->encode; my $expect = '00'; is( $binary, $expect, 'DNS root wire-format representation' ); } { my $ldh = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-0123456789'; my $domain = new Net::DNS::DomainName($ldh); my $subdomain = new Net::DNS::DomainName("sub.$ldh"); is( $domain->name, $ldh, '63 octet LDH character label' ); my @label = $domain->_wire; is( scalar(@label), 1, "name has single label" ); my $buffer = $domain->encode; my $hex = '3f' . '4142434445464748494a4b4c4d4e4f505152535455565758595a' . '6162636465666768696a6b6c6d6e6f707172737475767778797a' . '2d30313233343536373839' . '00'; is( lc unpack( 'H*', $buffer ), $hex, 'simple wire-format encoding' ); my ( $decoded, $offset ) = decode Net::DNS::DomainName( \$buffer ); is( $decoded->name, $domain->name, 'simple wire-format decoding' ); is( decode Net::DNS::DomainName( \$subdomain->encode )->name, $subdomain->name, 'simple wire-format decoding' ); my $data = '03737562c000c000c000'; $buffer .= pack( 'H*', $data ); my $cache = {}; ( $decoded, $offset ) = decode Net::DNS::DomainName( \$buffer, $offset, $cache ); is( $decoded->name, $subdomain->name, 'compressed wire-format decoding' ); my @labels = $decoded->_wire; is( scalar(@labels), 2, "decoded name has two labels" ); $decoded = decode Net::DNS::DomainName( \$buffer, $offset, $cache ); is( $decoded->name, $domain->name, 'compressed wire-format decoding' ); } { my $buffer = pack 'H*', '0200'; eval { my $domain = decode Net::DNS::DomainName( \$buffer ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } { my $buffer = pack 'H*', 'c002'; eval { my $domain = decode Net::DNS::DomainName( \$buffer ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "bad compression pointer\t[$exception]" ); } { my $buffer = pack 'H*', 'c000'; eval { my $domain = decode Net::DNS::DomainName( \$buffer ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "name compression loop\t[$exception]" ); } { my $hex = '40' . '4142434445464748494a4b4c4d4e4f505152535455565758595a' . '6162636465666768696a6b6c6d6e6f707172737475767778797a' . '2d30313233343536373839ff' . '00'; my $buffer = pack 'H*', $hex; eval { my $domain = decode Net::DNS::DomainName( \$buffer ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unsupported wire-format\t[$exception]" ); } { my $hex = '80' . '4142434445464748494a4b4c4d4e4f505152535455565758595a' . '6162636465666768696a6b6c6d6e6f707172737475767778797a' . '2d30313233343536373839ff' . '4142434445464748494a4b4c4d4e4f505152535455565758595a' . '6162636465666768696a6b6c6d6e6f707172737475767778797a' . '2d30313233343536373839ff' . '00'; my $buffer = pack 'H*', $hex; eval { my $domain = decode Net::DNS::DomainName( \$buffer ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unsupported wire-format\t[$exception]" ); } { foreach my $case ( '\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015', '\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031' ) { my $domain = new Net::DNS::DomainName($case); my $binary = $domain->encode; my $result = decode Net::DNS::DomainName( \$binary )->name; is( unpack( 'H*', $result ), unpack( 'H*', $case ), "C0 controls:\t$case" ); } } { foreach my $case ( '\032!"#$%&\'()*+,-\./', # 32 .. 47 '0123456789:;<=>?', # 48 .. '@ABCDEFGHIJKLMNO', # 64 .. 'PQRSTUVWXYZ[\\\\]^_', # 80 .. '`abcdefghijklmno', # 96 .. 'pqrstuvwxyz{|}~\127' # 112 .. ) { my $domain = new Net::DNS::DomainName($case); my $binary = $domain->encode; my $result = decode Net::DNS::DomainName( \$binary )->name; is( unpack( 'H*', $result ), unpack( 'H*', $case ), "G0 graphics:\t$case" ); } } { foreach my $case ( '\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143', '\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159', '\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175', '\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191', '\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207', '\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223', '\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239', '\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255' ) { my $domain = new Net::DNS::DomainName($case); my $binary = $domain->encode; my $result = decode Net::DNS::DomainName( \$binary )->name; is( unpack( 'H*', $result ), unpack( 'H*', $case ), "8-bit codes:\t$case" ); } } { my $domain = new Net::DNS::DomainName( uc 'EXAMPLE.COM' ); my $hash = {}; my $data = $domain->encode( 0, $hash ); my $compress = $domain->encode( length $data, $hash ); my $canonical = $domain->encode( length $data ); my $decoded = decode Net::DNS::DomainName( \$data ); my $downcased = new Net::DNS::DomainName( lc $domain->name )->encode( 0, {} ); ok( $domain->isa('Net::DNS::DomainName'), 'object returned by new() constructor' ); ok( $decoded->isa('Net::DNS::DomainName'), 'object returned by decode() constructor' ); is( length $compress, length $data, 'Net::DNS::DomainName wire encoding is uncompressed' ); isnt( $data, $downcased, 'Net::DNS::DomainName wire encoding preserves case' ); is( length $canonical, length $data, 'Net::DNS::DomainName canonical form is uncompressed' ); isnt( $canonical, $downcased, 'Net::DNS::DomainName canonical form preserves case' ); } { my $domain = new Net::DNS::DomainName1035( uc 'EXAMPLE.COM' ); my $hash = {}; my $data = $domain->encode( 0, $hash ); my $compress = $domain->encode( length $data, $hash ); my $canonical = $domain->encode( length $data ); my $decoded = decode Net::DNS::DomainName1035( \$data ); my $downcased = new Net::DNS::DomainName1035( lc $domain->name )->encode( 0x4000, {} ); ok( $domain->isa('Net::DNS::DomainName1035'), 'object returned by new() constructor' ); ok( $decoded->isa('Net::DNS::DomainName1035'), 'object returned by decode() constructor' ); isnt( length $compress, length $data, 'Net::DNS::DomainName1035 wire encoding is compressible' ); isnt( $data, $downcased, 'Net::DNS::DomainName1035 wire encoding preserves case' ); is( length $canonical, length $data, 'Net::DNS::DomainName1035 canonical form is uncompressed' ); is( $canonical, $downcased, 'Net::DNS::DomainName1035 canonical form is lower case' ); } { my $domain = new Net::DNS::DomainName2535( uc 'EXAMPLE.COM' ); my $hash = {}; my $data = $domain->encode( 0, $hash ); my $compress = $domain->encode( length $data, $hash ); my $canonical = $domain->encode( length $data ); my $decoded = decode Net::DNS::DomainName2535( \$data ); my $downcased = new Net::DNS::DomainName2535( lc $domain->name )->encode( 0, {} ); ok( $domain->isa('Net::DNS::DomainName2535'), 'object returned by new() constructor' ); ok( $decoded->isa('Net::DNS::DomainName2535'), 'object returned by decode() constructor' ); is( length $compress, length $data, 'Net::DNS::DomainName2535 wire encoding is uncompressed' ); isnt( $data, $downcased, 'Net::DNS::DomainName2535 wire encoding preserves case' ); is( length $canonical, length $data, 'Net::DNS::DomainName2535 canonical form is uncompressed' ); is( $canonical, $downcased, 'Net::DNS::DomainName2535 canonical form is lower case' ); } exit; Net-DNS-1.07/t/05-CDS.t0000644000175000017500000000333113031240164013432 0ustar willemwillem# $Id: 05-CDS.t 1517 2016-11-17 06:11:17Z willem $ -*-perl-*- use strict; use Test::More tests => 14; use Net::DNS; my $name = 'CDS.example'; my $type = 'CDS'; my $code = 59; my @attr = qw( keytag algorithm digtype digest ); my @data = ( 42495, 5, 1, '0ffbeba0831b10b8b83440dab81a2148576da9f6' ); my @also = qw( digestbin babble ); my $wire = join '', qw( A5FF 05 01 0FFBEBA0831B10B8B83440DAB81A2148576DA9F6 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name $type"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); $rr->algorithm('RSASHA512'); is( $rr->algorithm(), 10, 'algorithm mnemonic accepted' ); $rr->digtype('SHA256'); is( $rr->digtype(), 2, 'digest type mnemonic accepted' ); $rr->digtype(0); is( $rr->digtype(), 0, 'digest type 0 accepted' ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-DS.t0000644000175000017500000000717013031240164013334 0ustar willemwillem# $Id: 05-DS.t 1367 2015-06-29 08:53:56Z willem $ -*-perl-*- use strict; use Test::More tests => 32; use Net::DNS; my $name = 'DS.example'; my $type = 'DS'; my $code = 43; my @attr = qw( keytag algorithm digtype digest ); my @data = ( 60485, 5, 1, '2bb183af5f22588179a53b0a98631fad1a292118' ); my @also = qw( digestbin babble ); my $wire = qw( EC4505012BB183AF5F22588179A53B0A98631FAD1A292118 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name $type"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); } { my $rr = new Net::DNS::RR(". $type"); foreach ( @attr, 'rdstring' ) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR(". $type @data"); my $class = ref($rr); $rr->algorithm('RSASHA512'); is( $rr->algorithm(), 10, 'algorithm mnemonic accepted' ); is( $rr->algorithm('MNEMONIC'), 'RSASHA512', "rr->algorithm('MNEMONIC')" ); is( $class->algorithm('RSASHA512'), 10, "class method algorithm('RSASHA512')" ); is( $class->algorithm(10), 'RSASHA512', "class method algorithm(10)" ); is( $class->algorithm(255), 255, "class method algorithm(255)" ); eval { $rr->algorithm('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type @data"); my $class = ref($rr); $rr->digtype('SHA256'); is( $rr->digtype(), 2, 'digest type mnemonic accepted' ); is( $rr->digtype('MNEMONIC'), 'SHA-256', "rr->digtype('MNEMONIC')" ); is( $class->digtype('SHA256'), 2, "class method digtype('SHA256')" ); is( $class->digtype(2), 'SHA-256', "class method digtype(2)" ); is( $class->digtype(255), 255, "class method digtype(255)" ); eval { $rr->digtype('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type @data"); eval { $rr->digest('123456789XBCDEF'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt hexadecimal\t[$exception]" ); } { my $keyrr = new Net::DNS::RR( type => 'DNSKEY', protocol => 0 ); eval { create Net::DNS::RR::DS($keyrr); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "create: non-DNSSEC key\t[$exception]" ); } { my $keyrr = new Net::DNS::RR( type => 'DNSKEY', flags => 0x8000 ); eval { create Net::DNS::RR::DS($keyrr); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "create: non-auth key\t[$exception]" ); } { my $keyrr = new Net::DNS::RR( type => 'DNSKEY', flags => 0x200 ); eval { create Net::DNS::RR::DS($keyrr); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "create: non-ZONE key\t[$exception]" ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-ISDN.t0000644000175000017500000000357313031240164013566 0ustar willemwillem# $Id: 05-ISDN.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 13; use Net::DNS; my $name = 'ISDN.example'; my $type = 'ISDN'; my $code = 20; my @attr = qw( address sa ); my @data = qw( 150862028003217 004 ); my @also = qw( ISDNaddress ); my $wire = '0f31353038363230323830303332313703303034'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/03-rr.t0000644000175000017500000002446013031240164013450 0ustar willemwillem# $Id: 03-rr.t 1512 2016-10-26 09:14:27Z willem $ -*-perl-*- use strict; use Test::More tests => 101; BEGIN { use_ok('Net::DNS::RR'); } { ## check exception raised for unparsable argument foreach my $testcase ( undef, '', ' ', '. NULL x', '. OPT x', '. ATMA x', [], {} ) { eval { new Net::DNS::RR($testcase) }; my $exception = $1 if $@ =~ /^(.+)\n/; my $test = defined $testcase ? "'$testcase'" : 'undef'; ok( $exception ||= '', "new Net::DNS::RR($test)\t[$exception]" ); } } { ## check plausible ways to create empty record foreach my $testcase ( 'example.com A', 'example.com IN', 'example.com IN A', 'example.com IN 123 A', 'example.com 123 A', 'example.com 123 IN A', 'example.com 123 In Aaaa', 'example.com A \\# 0', ) { my $rr = new Net::DNS::RR("$testcase"); is( length( $rr->rdata ), 0, "new Net::DNS::RR( $testcase )" ); } } { ## check basic functions my ( $name, $class, $ttl, $type, $rdata ) = qw(example.com IN 123 A 192.0.2.1); my $rr = new Net::DNS::RR("$name $ttl $class $type $rdata"); my $rdlen = length( $rr->rdata ); is( $rr->owner, $name, 'expected value returned by $rr->owner' ); is( $rr->type, $type, 'expected value returned by $rr->type' ); is( $rr->class, $class, 'expected value returned by $rr->class' ); is( $rr->ttl, $ttl, 'expected value returned by $rr->ttl' ); is( $rr->rdstring, $rdata, 'expected value returned by $rr->rdstring' ); is( $rr->rdlength, $rdlen, 'expected value returned by $rr->length' ); } { ## check basic parsing of all acceptable forms of A record my $example = new Net::DNS::RR('example.com. 0 IN A 192.0.2.1'); my $expected = $example->string; foreach my $testcase ( join( "\t", qw( example.com 0 IN A ), q(\# 4 c0 00 02 01) ), join( "\t", qw( example.com 0 IN A ), q(\# 4 c0000201 ) ), 'example.com 0 IN A 192.0.2.1', 'example.com 0 IN TYPE1 192.0.2.1', 'example.com 0 CLASS1 A 192.0.2.1', 'example.com 0 CLASS1 TYPE1 192.0.2.1', 'example.com 0 A 192.0.2.1', 'example.com 0 TYPE1 192.0.2.1', 'example.com IN A 192.0.2.1', 'example.com IN TYPE1 192.0.2.1', 'example.com CLASS1 A 192.0.2.1', 'example.com CLASS1 TYPE1 192.0.2.1', 'example.com A 192.0.2.1', 'example.com TYPE1 192.0.2.1', 'example.com IN 0 A 192.0.2.1', 'example.com IN 0 TYPE1 192.0.2.1', 'example.com CLASS1 0 A 192.0.2.1', 'example.com CLASS1 0 TYPE1 192.0.2.1', ) { my $rr = new Net::DNS::RR("$testcase"); $rr->ttl( $example->ttl ); # TTL only shown if defined is( $rr->string, $expected, "new Net::DNS::RR( $testcase )" ); } } { ## check parsing of comments, quotes and brackets my $example = new Net::DNS::RR('example.com. 0 IN TXT "txt-data"'); my $expected = $example->string; foreach my $testcase ( q(example.com 0 IN TXT txt-data ; space delimited), q(example.com 0 TXT txt-data), q(example.com IN TXT txt-data), q(example.com TXT txt-data), q(example.com IN 0 TXT txt-data), q(example.com 0 IN TXT txt-data ; tab delimited), q(example.com 0 TXT txt-data), q(example.com IN TXT txt-data), q(example.com TXT txt-data), q(example.com IN 0 TXT txt-data), q(example.com 0 IN TXT "txt-data" ; "quoted"), q(example.com 0 TXT "txt-data"), q(example.com IN TXT "txt-data"), q(example.com TXT "txt-data"), q(example.com IN 0 TXT "txt-data"), 'example.com ( 0 IN TXT txt-data ) ; bracketed', ) { my $rr = new Net::DNS::RR("$testcase"); $rr->ttl( $example->ttl ); # TTL only shown if defined is( $rr->string, $expected, "new Net::DNS::RR( $testcase )" ); } } { ## check parsing of implemented RR type with hexadecimal RDATA my @common = qw( example.com. 3600 IN TXT ); my $expected = join "\t", @common, q("two separate" "quoted strings"); my $testcase = join "\t", @common, q(\# 28 0c74776f2073657061726174650e71756f74656420737472696e6773); my $rr = new Net::DNS::RR("$testcase"); is( $rr->string, $expected, "new Net::DNS::RR( $testcase )" ); } { ## check parsing of known but unimplemented RR type my $expected = join "\t", qw( example.com. 3600 IN ATMA ), q(\# 4 c0000201); my $testcase = join "\t", qw( example.com. 3600 IN TYPE34 ), q(\# 4 c0000201); my $rr = new Net::DNS::RR("$testcase"); is( $rr->string, $expected, "new Net::DNS::RR( $testcase )" ); } { ## check for exception if RR name not recognised my $testcase = join "\t", qw( example.com. 3600 IN BOGUS ), q(\# 4 c0000201); eval { new Net::DNS::RR($testcase) }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unrecognised RR type: $testcase\t[$exception]" ); } { ## check for exception if RFC3597 format hexadecimal data inconsistent foreach my $testcase ( '\# 0 c0 00 02 01', '\# 3 c0 00 02 01', '\# 5 c0 00 02 01' ) { eval { new Net::DNS::RR("example.com 3600 IN A $testcase") }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "mismatched length: $testcase\t[$exception]" ); } } { ## check object construction from attribute list foreach my $testcase ( [ type => 'A', address => '192.0.2.1' ], [ type => 'A', address => ['192.0.2.1'] ], [ type => 'A', rdata => 'addr' ], ) { my $rr = new Net::DNS::RR(@$testcase); is( length( $rr->rdata ), 4, "new Net::DNS::RR([ @$testcase ])" ); } foreach my $testcase ( [ type => 'A', rdata => '' ], [ name => 'example.com', type => 'MX' ], [ type => 'MX', class => 'IN', ttl => 123 ], ) { my $rr = new Net::DNS::RR(@$testcase); is( length( $rr->rdata ), 0, "new Net::DNS::RR([ @$testcase ])" ); } } { ## check for exception for nonexistent attribute foreach my $testcase ( [ type => 'A', nonexistent => 'x' ], [ type => 'ATMA', nonexistent => 'x' ], ) { eval { new Net::DNS::RR( @$testcase ) }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown method:\t[$exception]" ); } my $rr = new Net::DNS::RR( type => 'A' ); is( $rr->nonexistent, undef, 'suppress repeated unknown method exception' ); is( $rr->DESTROY, undef, 'DESTROY() exists to defeat pre-5.18 AUTOLOAD' ); } { ## check for exception on bad class method eval { xxxx Net::DNS::RR( type => 'X' ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown class method:\t[$exception]" ); } { ## check for exception when abusing $rr->type() my $rr = new Net::DNS::RR( type => 'A' ); eval { $rr->type('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "cannot change type:\t[$exception]" ); } { ## check for exception when abusing $rr->ttl() my $rr = new Net::DNS::RR( type => 'A' ); eval { $rr->ttl('1year'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown time unit:\t[$exception]" ); } { ## check for exception when abusing $rr->rdata() my $rr = new Net::DNS::RR( type => 'SOA' ); eval { $rr->rdata( pack 'H* H*', '00c000', '00000001' x 5 ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "compressed rdata:\t[$exception]" ); } { ## check propagation of exception in string() ## (relies on bug that nobody cares enough to fix) my $rr = new Net::DNS::RR( type => 'MINFO', emailbx => '.' ); eval { local $SIG{__WARN__} = sub { die @_ }; $rr->string(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception in string:\t[$exception]" ); } { ## check propagation of exception in rdstring() ## (relies on bug that nobody cares enough to fix) my $rr = new Net::DNS::RR( type => 'MINFO', emailbx => '.' ); eval { local $SIG{__WARN__} = sub { die @_ }; $rr->rdatastr(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception in rdstring:\t[$exception]" ); } { ## check encode/decode functions foreach my $testcase ( 'example.com A', 'example.com IN', 'example.com IN A', 'example.com IN 123 A', 'example.com 123 A', 'example.com 123 IN A', 'example.com A \\# 0', 'example.com A 192.0.2.1', ) { my $rr = new Net::DNS::RR("$testcase"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR(\$encoded); $rr->ttl( $decoded->ttl ) unless $rr->ttl; is( $decoded->string, $rr->string, "encode/decode $testcase" ); } my $opt = new Net::DNS::RR( type => 'OPT' ); my $encoded = $opt->encode; my ( $decoded, $offset ) = decode Net::DNS::RR(\$encoded); is( $decoded->string, $opt->string, "encode/decode OPT RR" ); is( $offset, length($encoded), "decode returns offset of next RR" ); } { ## check canonical encode function foreach my $testcase ( 'example.com 123 IN A', 'EXAMPLE.com 123 A 192.0.2.1', ) { my $rr = new Net::DNS::RR("$testcase"); my $expected = unpack 'H*', $rr->encode(0); my $canonical = unpack 'H*', $rr->canonical; is( $canonical, $expected, "canonical encode $testcase" ); } } { foreach my $testcase ( '', '000001', '0000010001000000010004', ) { my $wiredata = pack 'H*', $testcase; my $question = eval { decode Net::DNS::RR(\$wiredata); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } } { ## check plain format and long RR strings foreach my $testcase ( [join( ' ', 'example.com TXT', ' text' x 30 )], ['example.com. 600 IN SOA ( sns.dns.icann.org. noc.dns.icann.org. 2015082417 ;serial 7200 ;refresh 3600 ;retry 1209600 ;expire 3600 ;minimum )'], ) { my $rr = new Net::DNS::RR(@$testcase); my $test = new Net::DNS::RR( $rr->plain ); my $type = $rr->type; is( $test->string, $rr->string, "parse rr->plain for multiline $type" ); my $rfc3597 = new Net::DNS::RR( $rr->generic ); is( $rfc3597->string, $rr->string, "parse rr->generic RFC3597 format $type" ); } } { ## check RR sorting functions foreach my $attr ( [], ['preference'], ['X'] ) { my $func = Net::DNS::RR::MX->get_rrsort_func(@$attr); is( ref($func), 'CODE', "MX->get_rrsort_func(@$attr)" ); } } eval { ## exercise printing functions require Data::Dumper; local $Data::Dumper::Maxdepth; local $Data::Dumper::Sortkeys; my $object = new Net::DNS::RR('example.com A 192.0.2.1'); my $filename = "03-rr.tmp"; open( TEMP, ">$filename" ) || die "Could not open $filename for writing"; select( ( select(TEMP), $object->print )[0] ); select( ( select(TEMP), $object->dump )[0] ); $Data::Dumper::Maxdepth = 6; $Data::Dumper::Sortkeys = 1; select( ( select(TEMP), $object->dump )[0] ); close(TEMP); unlink($filename); }; exit; Net-DNS-1.07/t/22-TSIG-verify.t0000644000175000017500000001162313031240164015073 0ustar willemwillem# $Id: 22-TSIG-verify.t 1474 2016-04-12 13:21:25Z willem $ -*-perl-*- use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::HMAC Digest::MD5 Digest::SHA MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 28; my $tsig = new Net::DNS::RR( type => 'TSIG' ); my $class = ref($tsig); my $privatekey = 'Khmac-sha1.example.+161+39562.private'; END { unlink($privatekey) if defined $privatekey; } open( KEY, ">$privatekey" ) or die "$privatekey $!"; print KEY <<'END'; Private-key-format: v1.2 Algorithm: 161 (HMAC_SHA1) Key: xdX9m8UtQNbJUzUgQ4xDtUNZAmU= END close KEY; my $publickey = 'Khmac-md5.example.+157+53335.key'; END { unlink($publickey) if defined $publickey; } open( KEY, ">$publickey" ) or die "$publickey $!"; print KEY <<'END'; HMAC-MD5.example. IN KEY 512 3 157 ARDJZgtuTDzAWeSGYPAu9uJUkX0= END close KEY; { my $packet = new Net::DNS::Packet('query.example'); $packet->sign_tsig($privatekey); $packet->data; my $verified = $packet->verify(); ok( $verified, 'verify signed packet' ); is( ref($verified), $class, 'packet->verify returns TSIG' ); is( $packet->verifyerr, 'NOERROR', 'observe packet->verifyerr' ); } { my $packet = new Net::DNS::Packet('query.example'); $packet->sign_tsig($privatekey); $packet->data; $packet->push( update => rr_add( type => 'NULL' ) ); my $verified = $packet->verify(); ok( !$verified, 'unverifiable signed packet' ); is( $verified, undef, 'failed packet->verify returns undef' ); is( $packet->verifyerr, 'BADSIG', 'observe packet->verifyerr' ); } { my $query = new Net::DNS::Packet('query.example'); $query->sign_tsig($privatekey); $query->data; my $reply = $query->reply; $reply->sign_tsig($query); $reply->data; my $verified = $reply->verify($query); ok( $verified, 'verify reply packet' ); is( $reply->verifyerr, 'NOERROR', 'observe packet->verifyerr' ); } { my @packet = map { new Net::DNS::Packet($_) } 0 .. 3; my $signed = $privatekey; foreach my $packet (@packet) { $signed = $packet->sign_tsig($signed); $packet->data; is( ref($signed), $class, 'sign multi-packet' ); } my @verified; foreach my $packet (@packet) { my ($verified) = $packet->verify(@verified); @verified = ($verified); ok( $verified, 'verify multi-packet' ); } my @state; $packet[2]->sigrr->fudge(0); foreach my $packet (@packet) { my $tsig = $packet->verify(@state); @state = ($tsig); my $result = $packet->verifyerr; ok( $result, "unverifiable multi-packet: $result" ); } } { my $packet = new Net::DNS::Packet('query.example'); $packet->sign_tsig( $privatekey, fudge => 0 ); my $encoded = $packet->data; sleep 1; my $query = new Net::DNS::Packet( \$encoded ); my $verified = $query->verify(); is( $query->verifyerr, 'BADTIME', 'unverifiable query packet: BADTIME' ); } { my $packet = new Net::DNS::Packet(); $packet->sign_tsig($privatekey); $packet->sigrr->error('BADTIME'); my $encoded = $packet->data; my $decoded = new Net::DNS::Packet( \$encoded ); ok( $decoded->sigrr->other, 'time appended to BADTIME response' ); } { my $query = new Net::DNS::Packet('query.example'); $query->sign_tsig($privatekey); $query->data; my $reply = $query->reply; $reply->sign_tsig($publickey); $reply->data; my $verified = $reply->verify($query); is( $reply->verifyerr, 'BADKEY', 'unverifiable reply packet: BADKEY' ); } { my $packet0 = new Net::DNS::Packet(); my $chain = $packet0->sign_tsig($privatekey); $packet0->data; my $packet1 = new Net::DNS::Packet(); $packet1->sign_tsig($chain); $packet1->data; my $packetx = new Net::DNS::Packet(); $packetx->sign_tsig($publickey); $packetx->data; my $tsig = $packetx->verify(); my $verified = $packet1->verify($tsig); is( $packet1->verifyerr, 'BADKEY', 'unverifiable multi-packet: BADKEY' ); } { my $packet = new Net::DNS::Packet(); $packet->sign_tsig($publickey); $packet->data; $packet->sigrr->macbin( substr $packet->sigrr->macbin, 0, 9 ); $packet->verify(); is( $packet->verifyerr, 'FORMERR', 'signature too short: FORMERR' ); } { my $packet = new Net::DNS::Packet(); $packet->sign_tsig($publickey); $packet->data; my $macbin = $packet->sigrr->macbin; $packet->sigrr->macbin( join '', $packet->sigrr->macbin, 'x' ); $packet->verify(); is( $packet->verifyerr, 'FORMERR', 'signature too long: FORMERR' ); } { my $packet = new Net::DNS::Packet(); $packet->sign_tsig($privatekey); my $null = new Net::DNS::RR( type => 'NULL' ); eval { $packet->sigrr->verify($null); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unexpected argument\t[$exception]" ); } { my $packet = new Net::DNS::Packet(); $packet->sign_tsig($privatekey); my $null = new Net::DNS::RR( type => 'NULL' ); eval { $packet->sigrr->verify( $packet, $null ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unexpected argument\t[$exception]" ); } __END__ Net-DNS-1.07/t/custom.txt0000644000175000017500000000026013031240164014463 0ustar willemwillem# $Id: custom.txt 1418 2015-10-20 09:55:07Z willem $ domain t2.net-dns.org search alt.net-dns.org ext.net-dns.org nameserver 10.0.1.42 10.0.2.42 options attempts:2 inet6 bogus Net-DNS-1.07/t/53-DS-GOST.t0000644000175000017500000000220413031240164014102 0ustar willemwillem# $Id: 53-DS-GOST.t 1352 2015-06-02 08:13:13Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::GOST Digest::GOST::CryptoPro MIME::Base64 Net::DNS::RR::DNSKEY Net::DNS::RR::DS ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 3; # Simple known-answer tests based upon the examples given in RFC5933, section 4.1 my $dnskey = new Net::DNS::RR <<'END'; example.net. 86400 DNSKEY 257 3 12 ( LMgXRHzSbIJGn6i16K+sDjaDf/k1o9DbxScO gEYqYS/rlh2Mf+BRAY3QHPbwoPh2fkDKBroF SRGR7ZYcx+YIQw== ) ; key id = 40692 END my $ds = new Net::DNS::RR <<'END'; example.net. 3600 IN DS 40692 12 3 ( 22261A8B0E0D799183E35E24E2AD6BB58533CBA7E3B14D659E9CA09B 2071398F ) END my $test = create Net::DNS::RR::DS( $dnskey, digtype => 'GOST', ttl => 3600 ); is( $test->string, $ds->string, 'created DS matches RFC5933 example DS' ); ok( $test->verify($dnskey), 'created DS verifies RFC5933 example DNSKEY' ); ok( $ds->verify($dnskey), 'RFC5933 example DS verifies DNSKEY' ); $test->print; __END__ Net-DNS-1.07/t/33-NSEC3-hash.t0000644000175000017500000000270713031240164014564 0ustar willemwillem# $Id: 33-NSEC3-hash.t 1389 2015-09-09 13:09:43Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::SHA Net::DNS::RR::NSEC3; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 12; my $algorithm = 1; my $iteration = 12; my $salt = pack 'H*', 'aabbccdd'; ok( Net::DNS::RR::NSEC3::name2hash( 1, 'example' ), "defaulted arguments" ); ok( Net::DNS::RR::NSEC3::name2hash( 1, 'example', 12, $salt ), "explicit arguments" ); my %testcase = ( ## test vectors from RFC5155 'example' => '0p9mhaveqvm6t7vbl5lop2u3t2rp3tom', 'a.example' => '35mthgpgcu1qg68fab165klnsnk3dpvl', 'ai.example' => 'gjeqe526plbf1g8mklp59enfd789njgi', 'ns1.example' => '2t7b4g4vsa5smi47k61mv5bv1a22bojr', 'ns2.example' => 'q04jkcevqvmu85r014c7dkba38o0ji5r', 'w.example' => 'k8udemvp1j2f7eg6jebps17vp3n8i58h', '*.w.example' => 'r53bq7cc2uvmubfu5ocmm6pers9tk9en', 'x.w.example' => 'b4um86eghhds6nea196smvmlo4ors995', 'y.w.example' => 'ji6neoaepv8b5o6k4ev33abha8ht9fgc', 'x.y.w.example' => '2vptu5timamqttgl4luu9kg21e0aor3s', ); my @name = qw(example a.example ai.example ns1.example ns2.example w.example *.w.example x.w.example y.w.example x.y.w.example); foreach my $name (@name) { my $hash = $testcase{$name}; my @args = ( $algorithm, $name, $iteration, $salt ); is( Net::DNS::RR::NSEC3::name2hash(@args), $hash, "H($name)" ); } exit; Net-DNS-1.07/t/99-cleanup.t0000644000175000017500000000036613031240164014472 0ustar willemwillem# $Id: 99-cleanup.t 795 2009-01-26 17:28:44Z olaf $ -*-perl-*- use Test::More; plan tests => 1; diag ("Cleaning"); unlink("t/online.disabled") if (-e "t/online.disabled"); unlink("t/IPv6.disabled") if (-e "t/IPv6.disabled"); ok(1,"Dummy"); Net-DNS-1.07/t/04-packet-truncate.t0000644000175000017500000001134513031240164016116 0ustar willemwillem# $Id: 04-packet-truncate.t 1449 2016-02-01 12:27:12Z willem $ -*-perl-*- use strict; use Test::More tests => 33; use Net::DNS; use Net::DNS::ZoneFile; my $source = new Net::DNS::ZoneFile( \*DATA ); my @rr = $source->read; { my $packet = new Net::DNS::Packet('query.example.'); $packet->push( answer => @rr ); $packet->push( authority => @rr ); $packet->push( additional => @rr ); my $unlimited = length $packet->data; my %before = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional); my $truncated = length $packet->truncate($unlimited); ok( $truncated == $unlimited, "unconstrained packet length $unlimited" ); foreach my $section (qw(answer authority additional)) { my $before = $before{$section}; my $after = scalar( $packet->$section ); is( $after, $before, "$section section unchanged, $before RRs" ); } ok( !$packet->header->tc, 'header->tc flag not set' ); } { my $packet = new Net::DNS::Packet('query.example.'); $packet->push( answer => @rr ); $packet->push( authority => @rr ); $packet->push( additional => @rr ); my $unlimited = length $packet->data; my %before = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional); my $truncated = length $packet->truncate; # exercise default size ok( $truncated < $unlimited, "long packet was $unlimited, now $truncated" ); foreach my $section (qw(answer authority additional)) { my $before = $before{$section}; my $after = scalar( $packet->$section ); ok( $after < $before, "$section section was $before RRs, now $after" ); } ok( $packet->header->tc, 'header->tc flag set' ); } { my $packet = new Net::DNS::Packet('query.example.'); $packet->push( answer => @rr ); $packet->push( authority => @rr ); $packet->push( additional => @rr ); my $tsig = eval { $packet->sign_tsig( 'tsig.example', 'ARDJZgtuTDzAWeSGYPAu9uJUkX0=' ) }; my $unlimited = length $packet->data; my %before = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional); my $truncated = length $packet->data(512); # explicit minimum size ok( $truncated < $unlimited, "signed packet was $unlimited, now $truncated" ); foreach my $section (qw(answer authority additional)) { my $before = $before{$section}; my $after = scalar( $packet->$section ); ok( $after < $before, "$section section was $before RRs, now $after" ); } my $sigrr = $packet->sigrr; is( $sigrr, $tsig, 'TSIG still in additional section' ); ok( $packet->header->tc, 'header->tc flag set' ); } { my $packet = new Net::DNS::Packet('query.example.'); my @auth = map Net::DNS::RR->new( type => 'NS', nsdname => $_->name ), @rr; $packet->unique_push( authority => @auth ); $packet->push( additional => @rr ); $packet->edns->size(2048); # + all bells and whistles my $unlimited = length $packet->data; my %before = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional); my $truncated = length $packet->truncate; ok( $truncated < $unlimited, "referral packet was $unlimited, now $truncated" ); foreach my $section (qw(answer authority)) { my $before = $before{$section}; my $after = scalar( $packet->$section ); is( $after, $before, "$section section unchanged, $before RRs" ); } foreach my $section (qw(additional)) { my $before = $before{$section}; my $after = scalar( $packet->$section ); ok( $after <= $before, "$section section was $before RRs, now $after" ); } ok( !$packet->header->tc, 'header->tc flag not set' ); } { my $packet = new Net::DNS::Packet('query.example.'); $packet->push( additional => @rr, @rr ); # two of everything my $unlimited = length $packet->data; my $truncated = length $packet->truncate( $unlimited >> 1 ); ok( $truncated, "check RRsets in truncated additional section" ); my %rrset; foreach my $rr ( grep $_->type eq 'A', $packet->additional ) { my $name = $rr->name; $rrset{"$name. A"}++; } foreach my $rr ( grep $_->type eq 'AAAA', $packet->additional ) { my $name = $rr->name; $rrset{"$name. AAAA"}++; } my $expect = 2; foreach my $key ( sort keys %rrset ) { is( $rrset{$key}, $expect, "$key ; $expect RRs" ); } } exit; __DATA__ a.example. A 198.41.0.4 a.example. AAAA 2001:503:ba3e::2:30 b.example. A 192.228.79.201 b.example. AAAA 2001:500:84::b c.example. A 192.33.4.12 c.example. AAAA 2001:500:2::c d.example. A 199.7.91.13 d.example. AAAA 2001:500:2d::d e.example. A 192.203.230.10 f.example. A 192.5.5.241 f.example. AAAA 2001:500:2f::f g.example. A 192.112.36.4 h.example. A 128.63.2.53 h.example. AAAA 2001:500:1::803f:235 i.example. A 192.36.148.17 i.example. AAAA 2001:7fe::53 j.example. A 192.58.128.30 j.example. AAAA 2001:503:c27::2:30 k.example. A 193.0.14.129 k.example. AAAA 2001:7fd::1 l.example. A 199.7.83.42 l.example. AAAA 2001:500:3::42 m.example. A 202.12.27.33 m.example. AAAA 2001:dc3::35 Net-DNS-1.07/t/51-DS-SHA1.t0000644000175000017500000000213313031240164014021 0ustar willemwillem# $Id: 51-DS-SHA1.t 1352 2015-06-02 08:13:13Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::SHA MIME::Base64 Net::DNS::RR::KEY Net::DNS::RR::DS ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 3; # Simple known-answer tests based upon the examples given in RFC3658, section 2.7 my $key = new Net::DNS::RR <<'END'; dskey.example. IN KEY 256 3 1 ( AQPwHb4UL1U9RHaU8qP+Ts5bVOU1s7fYbj2b3CCbzNdj 4+/ECd18yKiyUQqKqQFWW5T3iVc8SJOKnueJHt/Jb/wt ) ; key id = 28668 END my $ds = new Net::DNS::RR <<'END'; dskey.example. IN DS 28668 1 1 ( 49fd46e6c4b45c55d4ac69cbd3cd34ac1afe51de ;xidez-ticuv-kicur-galah-hehyp-sopys-roges-titap-sakoz-vygat-vyxox ) END my $test = create Net::DNS::RR::DS( $key, digtype => 'SHA1', ); is( $test->string, $ds->string, 'created DS matches RFC3658 example DS' ); ok( $test->verify($key), 'created DS verifies RFC3658 example KEY' ); ok( $ds->verify($key), 'RFC3658 example DS verifies example KEY' ); $test->print; __END__ Net-DNS-1.07/t/05-LOC.t0000644000175000017500000000366213031240164013445 0ustar willemwillem# $Id: 05-LOC.t 1390 2015-09-11 11:42:11Z willem $ -*-perl-*- use strict; use Test::More tests => 24; use Net::DNS; my $name = 'LOC.example'; my $type = 'LOC'; my $code = 29; my @attr = qw( latitude longitude altitude size hp vp ); my @data = qw( 42.35799 -71.014338 -44 2000 10 10 ); my @also = qw( version latlon horiz_pre vert_pre ); my $wire = '002513138916cb3c70c310df00988550'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/08-IPv4.t0000644000175000017500000003743613031240164013623 0ustar willemwillem# $Id: 08-IPv4.t 1509 2016-10-03 12:59:22Z willem $ -*-perl-*- use strict; use Test::More; use t::NonFatal; use Net::DNS; use IO::Select; my $debug = 0; my @hints = qw( 198.41.0.4 192.228.79.201 192.33.4.12 199.7.91.13 192.203.230.10 192.5.5.241 192.112.36.4 198.97.190.53 192.36.148.17 192.58.128.30 193.0.14.129 199.7.83.42 202.12.27.33 ); exit( plan skip_all => 'Online tests disabled.' ) if -e 't/online.disabled'; exit( plan skip_all => 'Online tests disabled.' ) unless -e 't/online.enabled'; eval { my $resolver = new Net::DNS::Resolver( igntc => 1 ); exit plan skip_all => 'No nameservers' unless $resolver->nameservers; my $reply = $resolver->send(qw(. NS IN)) || die; my @ns = grep $_->type eq 'NS', $reply->answer, $reply->authority; exit plan skip_all => 'Local nameserver broken' unless scalar @ns; 1; } || exit( plan skip_all => 'Non-responding local nameserver' ); eval { my $resolver = new Net::DNS::Resolver( nameservers => [@hints] ); exit plan skip_all => 'No IPv4 transport' unless $resolver->nameservers; my $reply = $resolver->send(qw(. NS IN)) || die; my $from = $reply->answerfrom(); my @ns = grep $_->type eq 'NS', $reply->answer, $reply->authority; exit plan skip_all => "Unexpected response from $from" unless scalar @ns; exit plan skip_all => "Non-authoritative response from $from" unless $reply->header->aa; 1; } || exit( plan skip_all => 'Unable to reach global root nameservers' ); my $IP = eval { my @nsdname = qw(ns.net-dns.org mcvax.nlnet.nl ns.nlnetlabs.nl); my $resolver = new Net::DNS::Resolver(); $resolver->nameservers(@nsdname); $resolver->force_v4(1); my @ip = $resolver->nameservers(); scalar(@ip) ? [@ip] : undef; } || exit( plan skip_all => 'Unable to resolve nameserver name' ); my $NOIP = '0.0.0.0'; diag join( "\n\t", 'will use nameservers', @$IP ) if $debug; Net::DNS::Resolver->debug($debug); plan tests => 86; NonFatalBegin(); { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->send(...) UDP' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->send(...) TCP' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(1); my $udp = $resolver->send(qw(net-dns.org DNSKEY IN)); ok( $udp && $udp->header->tc, '$resolver->send(...) truncated UDP reply' ); $resolver->igntc(0); my $retry = $resolver->send(qw(net-dns.org DNSKEY IN)); ok( $retry && !$retry->header->tc, '$resolver->send(...) automatic TCP retry' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(0); my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->bgsend(...) UDP' ); while ( $resolver->bgbusy($udp) ) { sleep 1; } ok( $resolver->bgisready($udp), '$resolver->bgisready($udp)' ); ok( $resolver->bgread($udp), '$resolver->bgread($udp)' ); $resolver->usevc(1); my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->bgsend(...) TCP' ); while ( $resolver->bgbusy($tcp) ) { sleep 1; } ok( $resolver->bgread($tcp), '$resolver->bgread($tcp)' ); ok( !$resolver->bgbusy(undef), '!$resolver->bgbusy(undef)' ); ok( !$resolver->bgread(undef), '!$resolver->bgread(undef)' ); $resolver->udp_timeout(0); ok( !$resolver->bgread( ref($udp)->new ), '!$resolver->bgread(Socket->new)' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(1); my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); ok( $handle, '$resolver->bgsend(...) truncated UDP' ); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) ignore UDP truncation' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); ok( $handle, '$resolver->bgsend(...) truncated UDP' ); my $packet = $resolver->bgread($handle); ok( $packet && !$packet->header->tc, '$resolver->bgread($tcp) background TCP retry' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); $resolver->nameserver($NOIP); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) background TCP fail' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); my $appendix = ${*$handle}{net_dns_bg}; $$appendix[1]->header->id(undef); # random id my $bgread = $resolver->bgread($handle); ok( !$bgread, '$resolver->bgread($udp) id mismatch' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); delete ${*$handle}{net_dns_bg}; my $bgread = $resolver->bgread($handle); ok( $bgread, '$resolver->bgread($udp) workaround for SpamAssassin' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->persistent_udp(1); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $handle, '$resolver->bgsend(...) persistent UDP' ); my $bgread = $resolver->bgread($handle); ok( $bgread, '$resolver->bgread($udp)' ); my $test = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $test, '$resolver->bgsend(...) persistent UDP' ); is( $test, $handle, 'same UDP socket object used' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->persistent_tcp(1); $resolver->usevc(1); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $handle, '$resolver->bgsend(...) persistent TCP' ); my $bgread = $resolver->bgread($handle); ok( $bgread, '$resolver->bgread($tcp)' ); my $test = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $test, '$resolver->bgsend(...) persistent TCP' ); is( $test, $handle, 'same TCP socket object used' ); close($handle); my $recover = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $recover, 'connection recovered after close' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->srcaddr($NOIP); $resolver->srcport(2345); my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->bgsend(...) specify UDP local address & port' ); $resolver->usevc(1); my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->bgsend(...) specify TCP local address & port' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->srcport(-1); my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$udp, '$resolver->send(...) specify bad UDP source port' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$tcp, '$resolver->send(...) specify bad TCP source port' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->srcport(-1); my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( !$udp, '$resolver->bgsend(...) specify bad UDP source port' ); $resolver->usevc(1); my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); ok( !$tcp, '$resolver->bgsend(...) specify bad TCP source port' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) }; $resolver->igntc(1); my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( $udp, '$resolver->send(...) UDP + automatic TSIG' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( $tcp, '$resolver->send(...) TCP + automatic TSIG' ); my $bgread; foreach my $ip (@$IP) { $resolver->nameserver($ip); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); last if $bgread = $resolver->bgread($handle); } ok( $bgread, '$resolver->bgsend/read TCP + automatic TSIG' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(1); eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' ) }; my $udp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$udp, '$resolver->send(...) UDP + failed TSIG' ); $resolver->usevc(1); my $tcp = $resolver->send(qw(net-dns.org SOA IN)); ok( !$tcp, '$resolver->send(...) TCP + failed TSIG' ); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); my $bgread = $resolver->bgread($handle); ok( !$bgread, '$resolver->bgsend/read TCP + failed TSIG' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->retrans(0); $resolver->retry(0); my @query = ( undef, qw(SOA IN) ); ok( $resolver->query(@query), '$resolver->query( undef, ... ) defaults to "." ' ); ok( $resolver->search(@query), '$resolver->search( undef, ... ) defaults to "." ' ); $resolver->defnames(0); $resolver->dnsrch(0); ok( $resolver->search(@query), '$resolver->search() without dnsrch & defnames' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->searchlist('net'); my @query = (qw(us SOA IN)); ok( $resolver->query(@query), '$resolver->query( name, ... )' ); ok( $resolver->search(@query), '$resolver->search( name, ... )' ); $resolver->defnames(0); $resolver->dnsrch(0); ok( $resolver->query(@query), '$resolver->query() without defnames' ); ok( $resolver->search(@query), '$resolver->search() without dnsrch' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $udp = $resolver->query(qw(bogus.net-dns.org A IN)); ok( !$udp, '$resolver->query() nonexistent name UDP' ); $resolver->usevc(1); my $tcp = $resolver->query(qw(bogus.net-dns.org A IN)); ok( !$tcp, '$resolver->query() nonexistent name TCP' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $update = new Net::DNS::Update(qw(example.com)); ok( $resolver->send($update), '$resolver->send($update) UDP' ); $resolver->usevc(1); ok( $resolver->send($update), '$resolver->send($update) TCP' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP ); $resolver->retrans(0); $resolver->retry(0); $resolver->tcp_timeout(0); my @query = (qw(. SOA IN)); my $query = new Net::DNS::Packet(@query); ok( !$resolver->query(@query), '$resolver->query() failure' ); ok( !$resolver->search(@query), '$resolver->search() failure' ); $query->edns->option( 65001, pack 'x500' ); # pad to force TCP ok( !$resolver->send($query), '$resolver->send() failure' ); ok( !$resolver->bgsend($query), '$resolver->bgsend() failure' ); $resolver->usevc(1); my $update = new Net::DNS::Update('bogus.example.com'); ok( !$resolver->send($update), '$resolver->send() update' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $mx = 'mx2.t.net-dns.org'; my @rr = rr( $resolver, $mx, 'MX' ); is( scalar(@rr), 2, 'Net::DNS::rr() works with specified resolver' ); is( scalar rr( $resolver, $mx, 'MX' ), 2, 'Net::DNS::rr() works in scalar context' ); is( scalar rr( $mx, 'MX' ), 2, 'Net::DNS::rr() works with default resolver' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $mx = 'mx2.t.net-dns.org'; my @mx = mx( $resolver, $mx ); is( scalar(@mx), 2, 'Net::DNS::mx() works with specified resolver' ); # some people seem to use mx() in scalar context is( scalar mx( $resolver, $mx ), 2, 'Net::DNS::mx() works in scalar context' ); is( scalar mx($mx), 2, 'Net::DNS::mx() works with default resolver' ); is( scalar mx('bogus.t.net-dns.org'), 0, "Net::DNS::mx() works for bogus name" ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->tcp_timeout(10); my @zone = $resolver->axfr('net-dns.org'); ok( scalar(@zone), '$resolver->axfr() returns entire zone in list context' ); my @notauth = $resolver->axfr('bogus.net-dns.org'); my $notauth = $resolver->errorstring; ok( !scalar(@notauth), "mismatched zone\t[$notauth]" ); my $iterator = $resolver->axfr('net-dns.org'); ok( ref($iterator), '$resolver->axfr() returns iterator in scalar context' ); my $soa = eval { $iterator->() }; is( ref($soa), 'Net::DNS::RR::SOA', '$iterator->() returns initial SOA RR' ); my $i; eval { return unless $soa; $soa->serial(undef); # force SOA mismatch while ( $iterator->() ) { $i++; } }; my ($exception) = split /\n/, "$@\n"; ok( $i, '$iterator->() iterates through remaining RRs' ); ok( !eval { $iterator->() }, '$iterator->() returns undef after last RR' ); ok( $exception, "iterator exception\t[$exception]" ); my $axfr_start = $resolver->axfr_start('net-dns.org'); ok( $axfr_start, '$resolver->axfr_start() (historical)' ); ok( eval { $resolver->axfr_next() }, '$resolver->axfr_next() works' ); ok( $resolver->answerfrom(), '$resolver->answerfrom() works' ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) }; $resolver->tcp_timeout(10); my @zone = $resolver->axfr(); ok( scalar(@zone), '$resolver->axfr() with TSIG verify' ); my @notauth = $resolver->axfr('bogus.net-dns.org'); my $notauth = $resolver->errorstring; ok( !scalar(@notauth), "mismatched zone\t[$notauth]" ); eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' ) }; my @unverifiable = $resolver->axfr(); my $errorstring = $resolver->errorstring; ok( !scalar(@unverifiable), "mismatched key\t[$errorstring]" ); eval { $resolver->tsig(undef) }; my ($exception) = split /\n/, "$@\n"; ok( $exception, "undefined TSIG\t[$exception]" ); $resolver->srcport(-1); my @badsocket = $resolver->axfr(); my $badsocket = $resolver->errorstring; ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" ); } { my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP ); eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' ) }; my $query = new Net::DNS::Packet(qw(. SOA IN)); ok( $resolver->bgsend($query), '$resolver->bgsend() + automatic TSIG' ); ok( $resolver->bgsend($query), '$resolver->bgsend() + existing TSIG' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->nameservers(); ok( !$resolver->send(qw(. NS)), 'no nameservers' ); } { my $resolver = Net::DNS::Resolver->new(); $resolver->nameserver('cname.t.net-dns.org'); ok( scalar( $resolver->nameservers ), 'resolve nameserver cname' ); } { my $resolver = Net::DNS::Resolver->new(); my @warnings; local $SIG{__WARN__} = sub { push( @warnings, "@_" ); }; my $ns = 'bogus.example.com.'; my @ip = $resolver->nameserver($ns); my ($warning) = split /\n/, "@warnings\n"; ok( $warning, "unresolved nameserver warning\t[$warning]" ) || diag "\tnon-existent '$ns' resolved: @ip"; } { ## exercise exceptions in _axfr_next() my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) }; $resolver->tcp_timeout(10); { my $select = new IO::Select(); eval { $resolver->_axfr_next($select); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "TCP time out\t[$exception]" ); } { my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); my $socket = $resolver->_bgsend_tcp( $packet, $packet->data ); my $select = new IO::Select($socket); while ( $resolver->bgbusy($socket) ) { sleep 1 } my $discarded = ''; ## [size][id][status] [qdcount]... $socket->recv( $discarded, 6 ); eval { $resolver->_axfr_next($select); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt data\t[$exception]" ); } { my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); my $socket = $resolver->_bgsend_tcp( $packet, $packet->data ); my $select = new IO::Select($socket); eval { $resolver->_axfr_next( $select, $packet->sigrr ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "verify fail\t[$exception]" ); } } NonFatalEnd(); exit; __END__ Net-DNS-1.07/t/05-IPSECKEY.t0000644000175000017500000001002413031240164014232 0ustar willemwillem# $Id: 05-IPSECKEY.t 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 39; my $name = '38.2.0.192.in-addr.arpa'; my $type = 'IPSECKEY'; my $code = 45; my @attr = qw( precedence gatetype algorithm gateway key ); my @data = qw( 10 3 2 gateway.example.com AQNRU3mG7TVTO2BkR47usntb102uFJtugbo6BSGvgqt4AQ== ); my @also = qw( pubkey keybin ); my $wire = '0a03020767617465776179076578616d706c6503636f6d00010351537986ed35533b6064478eeeb27b5bd74dae149b6e81ba3a0521af82ab7801'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' ); } { my $rr = new Net::DNS::RR("$name $type @data"); foreach ( undef, qw(192.0.2.38 2001:db8:0:8002:0:0:2000:1 gateway.example.com) ) { my $gateway = $_ || '.'; $rr->gateway($gateway); is( scalar( $rr->gateway ), $_, "rr->gateway( '$gateway' )" ); my $rr2 = new Net::DNS::RR( $rr->string ); is( $rr2->rdstring, $rr->rdstring, 'new/string transparent' ); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); is( $decoded->rdstring, $rr->rdstring, 'encode/decode transparent' ); } } { my $rr = eval { new Net::DNS::RR( type => $type, gateway => 'X' ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unrecognised gateway type\t[$exception]" ); } { my $rr = eval { new Net::DNS::RR(". $type \\# 3 01ff05"); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception raised in decode\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type @data"); $rr->{gatetype} = 255; $rr->encode; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception raised in encode\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type @data"); $rr->{gatetype} = 255; eval { my $gateway = $rr->gateway; }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "exception raised in gateway\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "$_ attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-SSHFP.t0000644000175000017500000000431013031240164013702 0ustar willemwillem# $Id: 05-SSHFP.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; BEGIN { use Test::More; use Net::DNS; plan tests => 18; } my $name = 'host.example'; my $type = 'SSHFP'; my $code = 44; my @attr = qw( algorithm fptype fp ); my @data = qw( 2 1 123456789abcdef67890123456789abcdef67890 ); my @also = qw( fingerprint fpbin babble ); my $wire = '0201123456789abcdef67890123456789abcdef67890'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type @data"); eval { $rr->fp('123456789XBCDEF'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt hexadecimal\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/02-text.t0000644000175000017500000001342513031240164014007 0ustar willemwillem# $Id: 02-text.t 1355 2015-06-05 08:23:04Z willem $ -*-perl-*- use strict; use Test::More tests => 37; BEGIN { my $codeword = unpack 'H*', '[|'; my %codename = ( '5b7c' => 'ASCII superset', 'ba4f' => 'EBCDIC cp37', '4abb' => 'EBCDIC cp500', '4a6a' => 'EBCDIC cp875', '68bb' => 'EBCDIC cp1026', 'ad4f' => 'EBCDIC cp1047', 'bb4f' => 'EBCDIC posix-bc' ); my $encoding = $codename{lc $codeword} || "unknown codeset [$codeword]"; diag $encoding unless $encoding =~ /ASCII/; use_ok('Net::DNS::Text'); } { my $string = 'example'; my $object = new Net::DNS::Text($string); ok( $object->isa('Net::DNS::Text'), 'object returned by new() constructor' ); is( $object->value, $string, 'expected object->value' ); is( $object->string, $string, 'expected object->string' ); } { eval { my $object = new Net::DNS::Text(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "empty argument list\t[$exception]" ); } { eval { my $object = new Net::DNS::Text(undef); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "argument undefined\t[$exception]" ); } { my $sample = ''; my $expect = '""'; my $result = new Net::DNS::Text($sample)->string; is( $result, $expect, 'null argument' ); } { my $sample = 'example'; my $escape = '\e\x\a\m\p\l\e'; my $result = new Net::DNS::Text($escape)->string; is( $result, $sample, 'character escape' ); } { my $sample = 'A'; my $escape = '\065'; my $result = new Net::DNS::Text($escape)->string; is( $result, $sample, 'numeric escape' ); } { my $string = 'a' x 256; my $object = new Net::DNS::Text($string); is( scalar(@$object), 2, 'new() splits long argument' ); is( length( $object->value ), length($string), 'object->value reassembles string' ); is( length( $object->string ), length($string), 'object->string reassembles string' ); } { my $utf8 = '\192\160'; my $filler = 'a' x 254; my $string = join '', $filler, $utf8; my $object = new Net::DNS::Text($string); is( length( $object->[0] ), length($filler), 'new() does not break UTF8 sequence' ); } { my $sample = 'x\000x\031x\127x\128x\159\160\255x'; my $expect = '7800781f787f7880789fa0ff78'; my $length = sprintf '%02x', length pack( 'H*', $expect ); my $object = new Net::DNS::Text($sample); my $buffer = $object->encode; is( unpack( 'H*', $buffer ), $length . $expect, 'encode() returns expected data' ); is( unpack( 'H*', $object->raw ), $expect, 'raw() returns expected data' ); } { my $sample = 'example'; my $buffer = new Net::DNS::Text($sample)->encode; my $object = decode Net::DNS::Text( \$buffer ); ok( $object->isa('Net::DNS::Text'), 'object returned by decode() constructor' ); is( $object->string, $sample, 'object matches original data' ); my ( $x, $next ) = decode Net::DNS::Text( \$buffer ); is( $next, length $buffer, 'expected offset returned by decode()' ); } { my $sample = 'example'; my $buffer = new Net::DNS::Text($sample)->encode; my ( $object, $next ) = decode Net::DNS::Text( \$buffer, 1, length($buffer) - 1 ); is( $object->string, $sample, 'decode() extracts arbitrary substring' ); is( $next, length $buffer, 'expected offset returned by decode()' ); } { my $sample = 'example'; my $buffer = substr new Net::DNS::Text($sample)->encode, 0, 2; eval { my $object = decode Net::DNS::Text( \$buffer ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } { my %testcase = ( '000102030405060708090a0b0c0d0e0f' => '\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015', '101112131415161718191a1b1c1d1e1f' => '\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031', ); foreach my $hexcode ( sort keys %testcase ) { my $string = $testcase{$hexcode}; my $content = pack 'H*', $hexcode; my $buffer = pack 'C a*', length $content, $content; my $decoded = decode Net::DNS::Text( \$buffer ); my $compare = $decoded->string; is( $compare, qq($string), "C0 controls:\t$string" ); } } { my %testcase = ( '202122232425262728292a2b2c2d2e2f' => q|" !\"#$%&'()*+,-./"|, '303132333435363738393a3b3c3d3e3f' => '0123456789:\;<=>?', '404142434445464748494a4b4c4d4e4f' => '\@ABCDEFGHIJKLMNO', '505152535455565758595a5b5c5d5e5f' => 'PQRSTUVWXYZ[\\\\]^_', '606162636465666768696a6b6c6d6e6f' => '`abcdefghijklmno', '707172737475767778797a7b7c7d7e7f' => 'pqrstuvwxyz{|}~\127' ); foreach my $hexcode ( sort keys %testcase ) { my $string = $testcase{$hexcode}; my $content = pack 'H*', $hexcode; my $buffer = pack 'C a*', length $content, $content; my $decoded = decode Net::DNS::Text( \$buffer ); my $compare = $decoded->string; is( $compare, qq($string), "G0 graphics:\t$string" ); } } { my %testcase = ( '808182838485868788898a8b8c8d8e8f' => '\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143', '909192939495969798999a9b9c9d9e9f' => '\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159', 'a0a1a2a3a4a5a6a7a8a9aaabacadaeaf' => '\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175', 'b0b1b2b3b4b5b6b7b8b9babbbcbdbebf' => '\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191', 'c0c1c2c3c4c5c6c7c8c9cacbcccdcecf' => '\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207', 'd0d1d2d3d4d5d6d7d8d9dadbdcdddedf' => '\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223', 'e0e1e2e3e4e5e6e7e8e9eaebecedeeef' => '\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239', 'f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff' => '\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255' ); foreach my $hexcode ( sort keys %testcase ) { my $string = $testcase{$hexcode}; my $encoded = new Net::DNS::Text($string)->encode; is( unpack( 'xH*', $encoded ), $hexcode, qq(8-bit codes:\t$string) ); } } Net-DNS-1.07/t/04-packet.t0000644000175000017500000002044213031240164014271 0ustar willemwillem# $Id: 04-packet.t 1449 2016-02-01 12:27:12Z willem $ -*-perl-*- use strict; BEGIN { use Test::More tests => 99; use_ok('Net::DNS'); } # new() class constructor method must return object of appropriate class my $object = Net::DNS::Packet->new(); ok( $object->isa('Net::DNS::Packet'), 'new() object' ); ok( $object->header, 'header() method works' ); ok( $object->header->isa('Net::DNS::Header'), 'header() returns header object' ); ok( $object->edns, 'edns() method works' ); ok( $object->edns->isa('Net::DNS::RR::OPT'), 'edns() returns OPT RR object' ); like( $object->string, '/HEADER/', 'string() returns representation of packet' ); $object->header->opcode('UPDATE'); like( $object->string, '/UPDATE/', 'string() returns representation of update' ); # Empty packet created when new() arguments omitted my $empty = Net::DNS::Packet->new(); ok( $empty, 'create empty packet' ); foreach my $method ( qw(question answer authority additional), qw(zone pre prerequisite update) ) { my @result = $empty->$method; ok( @result == 0, "$method() returns empty list" ); } # Create a DNS query packet my ( $domain, $type, $class ) = qw(example.test MX IN); my $question = Net::DNS::Question->new( $domain, $type, $class ); my $packet = Net::DNS::Packet->new( $domain, $type, $class ); like( $packet->string, "/$class\t$type/", 'create query packet' ); my @question = $packet->question; ok( @question && @question == 1, 'packet->question() returns single element list' ); my ($q) = @question; ok( $q->isa('Net::DNS::Question'), 'list element is a question object' ); is( $q->string, $question->string, 'question object correct' ); # data() method returns non-empty scalar my $packet_data = $packet->data; ok( $packet_data, 'packet->data() method works' ); # new(\$data) class constructor method returns object of appropriate class my $packet2 = Net::DNS::Packet->new( \$packet_data ); ok( $packet2->isa('Net::DNS::Packet'), 'new(\$data) object' ); is( $packet2->string, $packet->string, 'decoded packet matches original' ); is( unpack( 'H*', $packet2->data ), unpack( 'H*', $packet_data ), 'retransmitted packet matches original' ); # new(\$data) class constructor captures exception text when data truncated my @data = unpack 'C*', $packet->data; while (@data) { pop(@data); my $truncated = pack 'C*', @data; my $length = length $truncated; my $object = Net::DNS::Packet->new( \$truncated ); my $exception = $@; $exception =~ s/\n.*$//g; ok( $exception, "truncated ($length octets):\t[$exception]" ); } # Use push() to add RRs to each section my $update = Net::DNS::Packet->new('.'); my $index; foreach my $section (qw(answer authority additional)) { my $i = ++$index; my $rr1 = Net::DNS::RR->new( Name => "$section$i.example.test", Type => "A", Address => "10.0.0.$i" ); my $string1 = $rr1->string; my $count1 = $update->push( $section, $rr1 ); like( $update->string, "/$string1/", "push first RR into $section section" ); is( $count1, 1, "push() returns $section RR count" ); my $j = ++$index; my $rr2 = Net::DNS::RR->new( Name => "$section$j.example.test", Type => "A", Address => "10.0.0.$j" ); my $string2 = $rr2->string; my $count2 = $update->push( $section, $rr2 ); like( $update->string, "/$string2/", "push second RR into $section section" ); is( $count2, 2, "push() returns $section RR count" ); } # Add enough distinct labels to render compression unusable at some point for ( 0 .. 255 ) { $update->push( 'answer', Net::DNS::RR->new( "X$_ TXT \"" . pack( "A255", "x" ) . '"' ) ); } $update->push( 'answer', Net::DNS::RR->new('XY TXT ""') ); $update->push( 'answer', Net::DNS::RR->new('VW.XY TXT ""') ); # Decode data buffer and compare with original my $buffer = $update->data; my $decoded = eval { Net::DNS::Packet->new( \$buffer ) }; ok( $decoded, 'new() from data buffer works' ); is( $decoded->answersize, length($buffer), '$decoded->answersize() works' ); $decoded->answerfrom('local'); ok( $decoded->answerfrom(), '$decoded->answerfrom() works' ); ok( $decoded->string(), '$decoded->string() works' ); foreach my $count (qw(qdcount ancount nscount arcount)) { is( $decoded->header->$count, $update->header->$count, "check header->$count correct" ); } foreach my $section (qw(question)) { my @original = map { $_->string } $update->$section; my @content = map { $_->string } $decoded->$section; is_deeply( \@content, \@original, "check content of $section section" ); } foreach my $section (qw(answer authority additional)) { my @original = map { $_->ttl(0); $_->string } $update->$section; # almost! need TTL defined my @content = map { $_->string } $decoded->$section; is_deeply( \@content, \@original, "check content of $section section" ); } # check that pop() removes RR from section Memo to self: no RR in question section! foreach my $section (qw(answer authority additional)) { my $c1 = $update->push( $section, Net::DNS::RR->new('X TXT ""') ); my $rr = $update->pop($section); my $c2 = $update->push($section); is( $c2, $c1 - 1, "pop() RR from $section section" ); } # Test using a predefined answer. # This is an answer that was generated by a bind server, with an option munged on the end. my $BIND = pack( 'H*', '22cc85000001000000010001056461636874036e657400001e0001c00c0006000100000e100025026e730472697065c012046f6c6166c02a7754e1ae0000a8c0000038400005460000001c2000002910000000800000050000000130' ); my $bind = Net::DNS::Packet->new( \$BIND ); is( $bind->header->qdcount, 1, 'check question count in synthetic packet header' ); is( $bind->header->ancount, 0, 'check answer count in synthetic packet header' ); is( $bind->header->nscount, 1, 'check authority count in synthetic packet header' ); is( $bind->header->adcount, 1, 'check additional count in synthetic packet header' ); my ($rr) = $bind->additional; is( $rr->type, 'OPT', 'Additional section packet is EDNS0 type' ); is( $rr->size, '4096', 'EDNS0 packet size correct' ); { ## check tolerance of invalid pop my $packet = new Net::DNS::Packet('example.com'); my $case1 = $packet->pop(''); my $case2 = $packet->pop('bogus'); } { ## check $packet->reply() my $packet = new Net::DNS::Packet('example.com'); my $reply = $packet->reply(); ok( $reply->isa('Net::DNS::Packet'), '$packet->reply() returns packet' ); eval { $reply->reply(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "reply->reply()\t[$exception]" ); my $udpmax = 2048; $packet->edns->size($udpmax); $packet->data; is( $packet->reply($udpmax)->edns->size(), $udpmax, 'packet->reply() supports EDNS' ); } { ## check $packet->sigrr my $packet = new Net::DNS::Packet(); is( $packet->sigrr(), undef, 'sigrr() undef for empty packet' ); $packet->push( additional => new Net::DNS::RR( type => 'OPT' ) ); is( $packet->sigrr(), undef, 'sigrr() undef for unsigned packet' ); is( $packet->verify(), undef, 'verify() fails for unsigned packet' ); ok( $packet->verifyerr(), 'verifyerr() returned for unsigned packet' ); } { ## go through the motions of SIG0 my $packet = new Net::DNS::Packet('example.com'); my $sig = new Net::DNS::RR( type => 'SIG' ); ok( $packet->sign_sig0($sig), 'sign_sig0() returns SIG0 record' ); is( ref( $packet->sigrr() ), ref($sig), 'sigrr() returns SIG RR' ); eval { $packet->sign_sig0( [] ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "sign_sig0([])\t[$exception]" ); } { ## check exception raised for bad TSIG my $packet = new Net::DNS::Packet('example.com'); my $bogus = new Net::DNS::RR( type => 'NULL' ); eval { $packet->sign_tsig($bogus); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "sign_tsig([])\t[$exception]" ); } eval { ## exercise but do not test print require Data::Dumper; local $Data::Dumper::Maxdepth; local $Data::Dumper::Sortkeys; my $object = new Net::DNS::Packet('example.com'); my $buffer = $object->data; my $corrupt = substr $buffer, 0, 10; my $filename = '04-packet.txt'; open( TEMP, ">$filename" ) || die "Could not open $filename for writing"; select( ( select(TEMP), $object->print )[0] ); select( ( select(TEMP), $object->dump )[0] ); $Data::Dumper::Maxdepth = 6; $Data::Dumper::Sortkeys = 1; select( ( select(TEMP), $object->dump )[0] ); select( ( select(TEMP), Net::DNS::Packet->new( \$buffer, 1 ) )[0] ); select( ( select(TEMP), Net::DNS::Packet->new( \$corrupt, 1 ) )[0] ); close(TEMP); unlink($filename); }; exit; Net-DNS-1.07/t/68-RRSIG-RSASHA256.t0000644000175000017500000000702313031240164015136 0ustar willemwillem# $Id: 68-RRSIG-RSASHA256.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::RSA Crypt::OpenSSL::Bignum Crypt::OpenSSL::RSA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; RSASHA256.example. IN DNSKEY 257 3 8 ( AwEAAcXr1phQtnOdThOrgcwRplS/btblbtLGeHQoba55Gr8Scbx7AAw+LjwtFmbPlDhklC8+4BAf QB+6Jv7hOFT45J/RqDV3W5p0qDYcLYJObNbiFxQ64ogMYHx62w4oUeTS5CvpHNzSoiyhhFlf71RL EVeBK798h+hdPeEWvHdzbwwMxZGIXP/eNN5u5tkNExuuqq3e6BeguCLsuLgMzHdfpl7W20z3BExD c28DgPRWHJtJcB+iUd5oQdrw+G9qSq4kb7vk3OZUGrgkZskicT1A5rQsOgc4SrT4d25Qd6fthmi2 hZ86Y/2DP/NfR1mwWaN8ty7daqdcNpFQmKwQ+qpIV5c= ; Key ID = 63427 ) END ok( $ksk, 'set up RSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.2 Algorithm: 8 (RSASHA256) Modulus: xevWmFC2c51OE6uBzBGmVL9u1uVu0sZ4dChtrnkavxJxvHsADD4uPC0WZs+UOGSULz7gEB9AH7om/uE4VPjkn9GoNXdbmnSoNhwtgk5s1uIXFDriiAxgfHrbDihR5NLkK+kc3NKiLKGEWV/vVEsRV4Erv3yH6F094Ra8d3NvDAzFkYhc/9403m7m2Q0TG66qrd7oF6C4Iuy4uAzMd1+mXtbbTPcETENzbwOA9FYcm0lwH6JR3mhB2vD4b2pKriRvu+Tc5lQauCRmySJxPUDmtCw6BzhKtPh3blB3p+2GaLaFnzpj/YM/819HWbBZo3y3Lt1qp1w2kVCYrBD6qkhXlw== PublicExponent: AQAB PrivateExponent: S3dyet+Dwi+/3pYtxr8QGg5oV/5htHLC6R+lOrqorSR+Q6zuxrxK6t0SRp9t19bZ/e3Oh7cyvyY+yj7cOOIyYpIRvllFj25d2UwDOkVnEMRiom8Vg2ScwboinpJXL5YONIQNYlHaToRDr8R5wD1jXmc9ZCU6uSocdyAxOqbEN+ZWNnzGHjs4onoGMLyc7f2NbMhSHVW9tp7zilCQ1W3OF6coWI/L/vGk1xBQZ+OtkRRbJCTca3qflLm/1vPq8/H3gS5adrJcO+/mUlhPoKxEqekZZp+FQJVHTYp3MyGTVXVl2M8sozf9lU/malzlqve5snMLfCOWH8MOdsx7eo0N+Q== Prime1: +ajh2Bbk8r2DBvCw3u3ipji7zeD1LLMRdYlSuCpyIWGGoiCJrqX34zFCdDOO1gKa2QQG3OAGk3hZ1ddcgr+bnVNIEuVxJXe0Wg4e0ZPNMCe1333Hyt7ws2U+zosYNfrxOdPkj/S5XZkVyRE1Ixa79WCBJms+zgDPx30AUQXblw0= Prime2: yvKWeFcJhIleHVNwEkNtq+aOgcIhS2ex7zc/zKFGSGYXdWIl17oM3ohiPgmLVznJtIkCIcYoxbfxuLW0NDe2OJC7PUjOB3lAmtHAH3ZafNbr/PdlAZzHUZiLsiHF/m5wd+pN37rCj7emjASwsGjcx3rRsJQvqVZARj/TXe9eQDM= Exponent1: nMBIbKCTR0VtyyG8K3w43hyo7e7cgSA9SgragP9FgWf2XD0JtTpHlcIL82GbwQsJplA87tlJx7W80eLSFtWvIuxzSEn+7INoHVLYTsX6As4sBxK2Ks4nWruq34u9u8a/Rouf6jLBX98KKqA/OLTBdqMM885KNJWV367AUB7ZbNE= Exponent2: FyUHR/4VFcpcs1d6pnqOHVaT1fR/u4u93Rwd6IZT75nE/xwMWMfdA9vl6FFKVM5AVJhzZ8qjh7jsljYSsQnRfC31TI3rASsw1Pcqw+vJcgdIrnbATCjHCmUtOUlkvRl3NhXAf81atu0ozzsRs2yiERXOqCaeMN+nQNuyjTnpM8U= Coefficient: iUz9xrXzP2UaBruIps61HAbh6MV+OYDmliSnudXW5Ii1s3ANXMJodzgwqD+VesjC9dDE2nXMTCXKhpk46Qy8i3OYJ4T7vxoyHEYfID1PM0+whAwebRoKHBqQDEYgwTcqDX+qD4MMc1TaG/do/cgNc/1EyE03DP1plH6HhItECIo= END close(KSK); my $key = new Net::DNS::RR <<'END'; RSASHA256.example. IN DNSKEY 256 3 8 ( AwEAAZRSF/5NLnExp5n4M6ynF2Yok3N2aG9AWu8/vKQrZGFQcbL+WPGYbWUtMpiNXmvzTr2j86kN QU4wBawm589mjzXgVQRfXYDMMFhHMtagzEKOiNy2ojhhFyS7r2O2vUbo4hGbnM54ynSM1al+ygKU Gy1TNzHuYMiwh+gsQCsC5hfJ ; Key ID = 35418 ) END ok( $key, 'set up RSA public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig, 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG over rrset using public ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/01-resolver-flags.t0000644000175000017500000000165213031240164015754 0ustar willemwillem# $Id: 01-resolver-flags.t 1444 2016-01-05 10:01:10Z willem $ -*-perl-*- use strict; use Test::More tests => 23; use Net::DNS; my $res = Net::DNS::Resolver->new(); ok( $res->isa('Net::DNS::Resolver'), 'new() created object' ); ok( !$res->dnssec(), "default dnssec flag off" ); my $udpsize = $res->udppacketsize(); $res->dnssec(1); ok( $res->dnssec(), "dnssec flag toggles on" ); my $size = $res->udppacketsize(); isnt( $size, $udpsize, "dnssec(1) sets udppacketsize ($size)" ); $res->dnssec(0); ok( !$res->dnssec(), "dnssec flag toggles off" ); my @flag = qw(adflag cdflag force_v4 force_v6 prefer_v4 prefer_v6); foreach my $flag (@flag) { my $default = $res->$flag(); my $changed = $default ? 0 : 1; ok( defined $default, "default $flag $default" ); $res->$flag($changed); is( $res->$flag(), $changed, "toggle $flag $changed" ); $res->$flag($default); is( $res->$flag(), $default, "toggle $flag $default" ); } exit; Net-DNS-1.07/t/52-DS-SHA256.t0000644000175000017500000000236013031240164014200 0ustar willemwillem# $Id: 52-DS-SHA256.t 1352 2015-06-02 08:13:13Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::SHA MIME::Base64 Net::DNS::RR::DNSKEY Net::DNS::RR::DS ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 3; # Simple known-answer tests based upon the examples given in RFC4509, section 2.3 my $dnskey = new Net::DNS::RR <<'END'; dskey.example.com. 86400 IN DNSKEY 256 3 5 ( AQOeiiR0GOMYkDshWoSKz9Xz fwJr1AYtsmx3TGkJaNXVbfi/ 2pHm822aJ5iI9BMzNXxeYCmZ DRD99WYwYqUSdjMmmAphXdvx egXd/M5+X7OrzKBaMbCVdFLU Uh6DhweJBjEVv5f2wwjM9Xzc nOf+EPbtG9DMBmADjFDc2w/r ljwvFw== ) ; key id = 60485 END my $ds = new Net::DNS::RR <<'END'; dskey.example.com. 86400 IN DS 60485 5 2 ( D4B7D520E7BB5F0F67674A0C CEB1E3E0614B93C4F9E99B83 83F6A1E4469DA50A ) END my $test = create Net::DNS::RR::DS( $dnskey, digtype => 'SHA256' ); is( $test->string, $ds->string, 'created DS matches RFC4509 example DS' ); ok( $test->verify($dnskey), 'created DS verifies RFC4509 example DNSKEY' ); ok( $ds->verify($dnskey), 'RFC4509 example DS verifies DNSKEY' ); $test->print; __END__ Net-DNS-1.07/t/35-NSEC3-match.t0000644000175000017500000000260413031240164014733 0ustar willemwillem# $Id: 35-NSEC3-match.t 1389 2015-09-09 13:09:43Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::SHA Net::DNS::RR::NSEC3; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 10; my $algorithm = 1; ## test vectors from RFC5155 my $flags = 0; my $iteration = 12; my $salt = 'aabbccdd'; my $hnxtname = 'irrelevent'; my @name = qw(example a.example ai.example ns1.example ns2.example w.example *.w.example x.w.example y.w.example x.y.w.example); my %testcase = ( 'example' => '0p9mhaveqvm6t7vbl5lop2u3t2rp3tom', 'a.example' => '35mthgpgcu1qg68fab165klnsnk3dpvl', 'ai.example' => 'gjeqe526plbf1g8mklp59enfd789njgi', 'ns1.example' => '2t7b4g4vsa5smi47k61mv5bv1a22bojr', 'ns2.example' => 'q04jkcevqvmu85r014c7dkba38o0ji5r', 'w.example' => 'k8udemvp1j2f7eg6jebps17vp3n8i58h', '*.w.example' => 'r53bq7cc2uvmubfu5ocmm6pers9tk9en', 'x.w.example' => 'b4um86eghhds6nea196smvmlo4ors995', 'y.w.example' => 'ji6neoaepv8b5o6k4ev33abha8ht9fgc', 'x.y.w.example' => '2vptu5timamqttgl4luu9kg21e0aor3s', ); foreach my $name (@name) { my $hash = $testcase{$name}; my @args = ( $algorithm, $flags, $iteration, $salt, $hnxtname ); my $nsec3 = new Net::DNS::RR("$hash.example. NSEC3 @args"); ok( $nsec3->match($name), "nsec3->match($name)" ); } exit; Net-DNS-1.07/t/08-recurse.t0000644000175000017500000000633413031240164014502 0ustar willemwillem# $Id: 08-recurse.t 1472 2016-04-04 21:49:18Z willem $ -*-perl-*- use strict; use Test::More; use t::NonFatal; use Net::DNS; use Net::DNS::Resolver::Recurse; exit( plan skip_all => 'Online tests disabled.' ) if -e 't/online.disabled'; exit( plan skip_all => 'Online tests disabled.' ) unless -e 't/online.enabled'; eval { my $resolver = new Net::DNS::Resolver(); exit plan skip_all => 'No nameservers' unless $resolver->nameservers; my $reply = $resolver->send(qw(. NS IN)) || die; my @ns = grep $_->type eq 'NS', $reply->answer, $reply->authority; exit plan skip_all => 'Local nameserver broken' unless scalar @ns; 1; } || exit( plan skip_all => 'Non-responding local nameserver' ); eval { my $resolver = new Net::DNS::Resolver::Recurse(); exit plan skip_all => "No nameservers" unless $resolver->nameservers; my $reply = $resolver->send(qw(. NS IN)) || die; my $from = $reply->answerfrom(); my @ns = grep $_->type eq 'NS', $reply->answer; exit plan skip_all => "No NS RRs in response from $from" unless scalar @ns; exit plan skip_all => "Non-authoritative response from $from" unless $reply->header->aa; 1; } || exit( plan skip_all => 'Unable to reach global root nameservers' ); plan 'no_plan'; NonFatalBegin(); { my $res = Net::DNS::Resolver::Recurse->new( debug => 0 ); ok( $res->isa('Net::DNS::Resolver::Recurse'), 'new() created object' ); my $packet = $res->query_dorecursion( 'www.net-dns.org', 'A' ); ok( $packet, 'got a packet' ); ok( scalar $packet->answer, 'answer section has RRs' ) if $packet; } { # test the callback my $res = Net::DNS::Resolver::Recurse->new( debug => 0 ); my $count = 0; $res->recursion_callback( sub { ok( shift->isa('Net::DNS::Packet'), 'callback argument is a packet' ); $count++; } ); $res->query_dorecursion( 'a.t.net-dns.org', 'A' ); ok( $count >= 3, "Lookup took $count queries which is at least 3" ); } { my $res = Net::DNS::Resolver::Recurse->new( debug => 0 ); my $count = 0; $res->recursion_callback( sub { $count++; } ); $res->query_dorecursion( '2a04:b900:0:0:8:0:0:60', 'PTR' ); ok( $count >= 3, "Reverse lookup took $count queries" ); } SKIP: { my @hints = new Net::DNS::Resolver::Recurse()->_hints; my $res = Net::DNS::Resolver::Recurse->new(); is( scalar( $res->hints() ), 0, "hints() initially empty" ); $res->hints(@hints); is( scalar( $res->hints ), scalar(@hints), "hints() set" ); my $reply = $res->send( ".", "NS" ); ok( $reply, 'got response to priming query' ); skip( 'no response to priming query', 3 ) unless $reply; my $from = $reply->answerfrom(); ok( $reply->header->aa, "authoritative response from $from" ); my @ns = grep $_->type eq 'NS', $reply->answer; ok( scalar(@ns), "NS RRs in response from $from" ); my @ar = grep $_->can('address'), $reply->additional; ok( scalar(@ar), "address RRs in response from $from" ); } { my $res = Net::DNS::Resolver::Recurse->new(); $res->retrans(0); $res->retry(0); $res->srcport(-1); ok( !$res->send( "www.net-dns.org", "A" ), 'fail if no reachable server' ); } { Net::DNS::Resolver->retry(0); my $res = Net::DNS::Resolver::Recurse->new(); $res->hints( '0.0.0.0', '::' ); ok( !$res->send( "www.net-dns.org", "A" ), 'fail if no usable hint' ); } NonFatalEnd(); exit; Net-DNS-1.07/t/66-RRSIG-NSEC3DSA.t0000644000175000017500000000612513031240164015063 0ustar willemwillem# $Id: 66-RRSIG-NSEC3DSA.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::DSA Crypt::OpenSSL::DSA Digest::SHA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; NSEC3DSA.example. IN DNSKEY 257 3 6 ( CJKE0tUKX4bcWPMHxXgbj6TA8kXXliaWQvjf/bdx2gYSilEjBb6i7bg5nz54Z1qLg/KHhgdxyalZ u5gXonPMwIPixVa6Q8cIIkDfnHG5YQdyA4CjUC5sa50rGrxn2Z1cdXs2451WMGENU1M/sWBO8+LO ReC+a9J69p3vjtGCDl4q16bQ1Fw3PhFdcu7gc8pqFbkDzRVDCydRKUxSGosuQ09WfNX+PmF8C6a7 4FOtD+q2FYamKVNN7Aq2unT32bitAbNQq6bulg366paCufYrCzYbnTGIsMC97SkKPNKuoHrW3uUA 62TraF+LAvKkm9A7Rns/21ReGKHUjiu6ngSd/vfo3poPWhygjcW0E678q7mJQKEfNg8IoCW6gj4F wQw6FIH3gTgBDjRYksqL/YdkJ05scRYc9WeRum5vEdxl/yKOJS26zoNtz3HxgwyQnhm4P+zVOM07 PznOpG3be7c6CTta/KQX5ldhvUdVUHqg93ZFr+R4TTPIVTIxI01jP8oMex8+GBg4rK3AmppWdADf 9BEPY7KS ; Key ID = 7777 ) END ok( $ksk, 'set up DSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.2 Algorithm: 6 (NSEC3DSA) Prime(p): liaWQvjf/bdx2gYSilEjBb6i7bg5nz54Z1qLg/KHhgdxyalZu5gXonPMwIPixVa6Q8cIIkDfnHG5YQdyA4CjUC5sa50rGrxn2Z1cdXs2451WMGENU1M/sWBO8+LOReC+a9J69p3vjtGCDl4q16bQ1Fw3PhFdcu7gc8pqFbkDzRU= Subprime(q): koTS1QpfhtxY8wfFeBuPpMDyRdc= Base(g): QwsnUSlMUhqLLkNPVnzV/j5hfAumu+BTrQ/qthWGpilTTewKtrp099m4rQGzUKum7pYN+uqWgrn2Kws2G50xiLDAve0pCjzSrqB61t7lAOtk62hfiwLypJvQO0Z7P9tUXhih1I4rup4Enf736N6aD1ocoI3FtBOu/Ku5iUChHzY= Private_value(x): T/W3QlYjZFFRbWzpmqL40K/EGKs= Public_value(y): DwigJbqCPgXBDDoUgfeBOAEONFiSyov9h2QnTmxxFhz1Z5G6bm8R3GX/Io4lLbrOg23PcfGDDJCeGbg/7NU4zTs/Oc6kbdt7tzoJO1r8pBfmV2G9R1VQeqD3dkWv5HhNM8hVMjEjTWM/ygx7Hz4YGDisrcCamlZ0AN/0EQ9jspI= END close(KSK); my $key = new Net::DNS::RR <<'END'; NSEC3DSA.example. IN DNSKEY 256 3 6 ( CIZJBhYteVknIchSnSCb0OXo0Lm7+6WMUjTn/stjMJZow+DoQ3wQ5m8HqWULYzwRO6OMkDs5wulZ 6lH+2rIr9P4T3N37C1qh0bowV7dnNqRh+DgPQzQU9hst+3+T9A1RaCecq71x+mWkK0YEp99fQiOW +wszImAp9kaKTBGutZ7FxWnlBe1ogQCzjn/BKVudb6KiFMF2tMLT2RL/3tWY37ZJY9D/Vbk850ym OAeZHl2cu8LVVO+XQ8/sWbCMM0mdfxwUVq56ygANI/NhJN5DU6D/Gpn9N/5ZJU+KYs+2NvuPNyHu g2yhEauYOzHX4YQJRTC5ZL1hRJWyDMK2+FQHBXaVB/PDHlkxtRAXQDHjMT4aGV3HhdkF/3m5c0ls EXK5r3oQPCxKILLInh7pw1dgNuGYoUpzaIUAgvwmx7d+3bPpG5PgRyLYPmVCZ8A46gUj2eBkFRCL 3vcX24e8haSo4c4v1bXnC1AX+uTf8/6ZnNGEcnAjUJ66AoTy5+9KPFMKcpkUjVBUFOZS+VlL921S eYKQ98nF ; Key ID = 16883 ) END ok( $key, 'set up DSA public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig->sig(), 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG over rrset using public ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/63-RRSIG-DSA.t0000644000175000017500000000607313031240164014326 0ustar willemwillem# $Id: 63-RRSIG-DSA.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::DSA Crypt::OpenSSL::DSA Digest::SHA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; DSA.example. IN DNSKEY 257 3 3 ( CKrKbLrir4slVXYFrA4Y8Rik/UxzkCo1Rp0Spz907VrJL8u3I/YKTTvoMh/GL2n3/NL/KgzNRWb8 pLB3FIWHjXXhn3r3sbld180DI4tv98CZKr86UDP0UUHVE/DkkEZw5PAy2nyhhKTJRvbR4ZT0OSZY +GZA2hIzmMYk4gR2mwa3jCmAGqw2i0OtAYzSOe06uoELZLl96kRsFk69OcQxzrDKz5BEZZpNBpfZ UBk/CRPDxBE2xjJkq3VpehAUCMOFpPQlEuW2D6CNuIbJY5pNpOF3RF17vkvxQx6678ZLIN3PdeG/ nGwoJJArbt7Y/q+b/NxnIu6RwApE40p/7pOq6qKcqPVU2oHR/N7oNiyHnh68gSonUFfy5lETiyw8 vDaJS/JhC2WQKzxxBo4oa/KFXFAd6NR6bE5h5XRWWqZvm2sBgcy+sKTbKcR4PDvaAoMguBjDeigm /NV6phNbARV926NyQZOi5uUeBYA16v1KnUll7A3I9wt3ykVIbx0WqB4Ozzk2PF/3vH3wudO5bL72 zK1Yox60 ; Key ID = 53264 ) END ok( $ksk, 'set up DSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.2 Algorithm: 3 (DSA) Prime(p): kCo1Rp0Spz907VrJL8u3I/YKTTvoMh/GL2n3/NL/KgzNRWb8pLB3FIWHjXXhn3r3sbld180DI4tv98CZKr86UDP0UUHVE/DkkEZw5PAy2nyhhKTJRvbR4ZT0OSZY+GZA2hIzmMYk4gR2mwa3jCmAGqw2i0OtAYzSOe06uoELZLk= Subprime(q): qspsuuKviyVVdgWsDhjxGKT9THM= Base(g): fepEbBZOvTnEMc6wys+QRGWaTQaX2VAZPwkTw8QRNsYyZKt1aXoQFAjDhaT0JRLltg+gjbiGyWOaTaThd0Rde75L8UMeuu/GSyDdz3Xhv5xsKCSQK27e2P6vm/zcZyLukcAKRONKf+6TquqinKj1VNqB0fze6DYsh54evIEqJ1A= Private_value(x): drOKJBTwCM0O9U6tpIgymGyBrao= Public_value(y): V/LmUROLLDy8NolL8mELZZArPHEGjihr8oVcUB3o1HpsTmHldFZapm+bawGBzL6wpNspxHg8O9oCgyC4GMN6KCb81XqmE1sBFX3bo3JBk6Lm5R4FgDXq/UqdSWXsDcj3C3fKRUhvHRaoHg7POTY8X/e8ffC507lsvvbMrVijHrQ= END close(KSK); my $key = new Net::DNS::RR <<'END'; DSA.example. IN DNSKEY 256 3 3 ( CMKzsCaT2Jy1w/sPdpigEE+nbeJ/x5C6cruWvStVum6/YulcR7MHeujx9c2iBDbo3kW4X8/l+qgk 7ZEZ+yV5lphWtJMmMtOHIU+YdAhgLpt84NKhcupWL8wfuBW/97cqIv5Z+51fwn0YEAcZsoCrE0nL 5+31VfkK9LTNuVo38hsbWa3eWZFalID5NesF6sJRgXZoAyeAH46EQVCq1UBnnaHslvSDkdb+Z1kT bMQ64ZVI/sBRXRbqIcDlXVZurCTDV7JL9KZwwfeyrQcnVyYh5mdHPsXbpX5NQJvoqPgvRZWBpP4h pjkAm9UrUbow9maPCQ1JQ3JuiU5buh9cjAI+QIyGMujKLT2OsogSZD2IFUciaZBL/rSe0gmAUv0q XrczmIYFUCoRGZ6+lKVqQQ6f2U7Gsr6zRbeJN+JCVD6BJ52zjLUaWUPHbakhZb/wMO7roX/tnA/w zoDYBIIF7yuRYWblgPXBJTK2Bp07xre8lKCRbzY4J/VXZFziZgHgcn9tkHnrfov04UG9zlWEdT6X E/60HjrP ; Key ID = 53244 ) END ok( $key, 'set up DSA public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig, 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG over rrset using public ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/00-load.t0000644000175000017500000000325213031240164013735 0ustar willemwillem# $Id: 00-load.t 1460 2016-02-25 09:55:34Z willem $ -*-perl-*- use strict; use Test::More; my @module = qw( Net::DNS Net::DNS::SEC Data::Dumper Digest::BubbleBabble Digest::GOST Digest::HMAC Digest::MD5 Digest::SHA File::Spec FileHandle IO::File IO::Select IO::Socket IO::Socket::INET IO::Socket::INET6 IO::Socket::IP MIME::Base64 Net::LibIDN PerlIO Scalar::Util Socket Time::Local ); diag("\n\nThese tests were run using:\n"); foreach my $module (@module) { my $loaded = eval("require $module") || next; my $revnum = $loaded ? $module->VERSION : "\t\tn/a"; diag sprintf "\t%-25s %s", $module, $revnum || '?'; } diag("set environment variable NET_DNS_DEBUG to get all versions\n\n"); plan tests => 20 + scalar(@Net::DNS::EXPORT); use_ok('Net::DNS'); is( Net::DNS->version, $Net::DNS::VERSION, 'Net::DNS->version'); # # Check on-demand loading using this (incomplete) list of RR packages my @rrs = qw( A AAAA CNAME MX NS NULL PTR SOA TXT ); sub is_rr_loaded { my $rr = shift; return $INC{"Net/DNS/RR/$rr.pm"} ? 1 : 0; } # # Make sure that we start with none of the RR packages loaded foreach my $rr (@rrs) { ok( !is_rr_loaded($rr), "not yet loaded Net::DNS::RR::$rr" ); } # # Check that each RR package is loaded on demand local $SIG{__WARN__} = sub { }; # suppress warnings foreach my $rr (@rrs) { my $object = eval { new Net::DNS::RR( name => '.', type => $rr ); }; diag($@) if $@; # report exceptions ok( is_rr_loaded($rr), "loaded package Net::DNS::RR::$rr" ); } # # Check that Net::DNS symbol table was imported correctly { no strict 'refs'; foreach my $sym (@Net::DNS::EXPORT) { ok( defined &{$sym}, "$sym is imported" ); } } exit; Net-DNS-1.07/t/05-L32.t0000644000175000017500000000352313031240164013364 0ustar willemwillem# $Id: 05-L32.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 12; use Net::DNS; my $name = 'L32.example'; my $type = 'L32'; my $code = 105; my @attr = qw( preference locator32 ); my @data = qw( 10 10.1.2.0 ); my @also = qw( ); my $wire = '000a0a010200'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/72-RRSIG-ECC-GOST.t0000644000175000017500000000333513031240164015061 0ustar willemwillem# $Id: 72-RRSIG-ECC-GOST.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::ECCGOST Crypt::OpenSSL::Bignum Crypt::OpenSSL::EC Crypt::OpenSSL::ECDSA Digest::GOST ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; ecc-gost.example. IN DNSKEY 257 3 12 ( 6VwgNT1BXxXNVpTQXcJQ82PcsCYmI60oN88Plbl028ruvl6DqJby/uBGULHT5FXmZiXBJozE6kP0 +BirN9YPBQ== ; Key ID = 46388 ) END ok( $ksk, 'set up ECC-GOST public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.3 Algorithm: 12 (ECC-GOST) PrivateKey: nBnGCP/hYTdJX0znDstyFTVYSA6b0nFeHy0FJUj7LhU= Created: 20150102211707 Publish: 20150102211707 Activate: 20150102211707 END close(KSK); my $key = new Net::DNS::RR <<'END'; ecc-gost.example. IN DNSKEY 256 3 12 ( LMgXRHzSbIJGn6i16K+sDjaDf/k1o9DbxScOgEYqYS/rlh2Mf+BRAY3QHPbwoPh2fkDKBroFSRGR 7ZYcx+YIQw== ; Key ID = 40691 ) END ok( $key, 'set up ECC-GOST public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig, 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG using ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/05-NAPTR.t0000644000175000017500000000502413031240164013706 0ustar willemwillem# $Id: 05-NAPTR.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 23; use Net::DNS; my $name = '2.1.2.1.5.5.5.0.7.7.1.e164.arpa.'; my $type = 'NAPTR'; my $code = 35; my @attr = qw( order preference flags service regexp replacement ); my @data = qw( 100 10 u sip+E2U !^.*$!sip:information@foo.se!i . ); my @also = qw( ); my $wire = '0064000a0175077369702b4532551e215e2e2a24217369703a696e666f726d6174696f6e40666f6f2e7365216900'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR('. NAPTR 100 50 "s" "http+N2L+N2C+N2R" "" www.example.com.'); my $rr = new Net::DNS::RR('. NAPTR 100 50 "s" "http+N2L+N2C+N2R" "" WWW.EXAMPLE.COM.'); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-TLSA.t0000644000175000017500000000450413031240164013567 0ustar willemwillem# $Id: 05-TLSA.t 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- use strict; use Test::More tests => 19; use Net::DNS; my $name = '_443._tcp.www.example.com'; my $type = 'TLSA'; my $code = 52; my @attr = qw( usage selector matchingtype certificate ); my @data = qw( 1 1 2 92003ba34942dc74152e2f2c408d29eca5a520e7f2e06bb944f4dca346baf63c1b177615d466f6c4b71c216a50292bd58c9ebdd2f74e38fe51ffd48c43326cbc ); my @also = qw( certbin babble ); my $wire = '01010292003ba34942dc74152e2f2c408d29eca5a520e7f2e06bb944f4dca346baf63c1b177615d466f6c4b71c216a50292bd58c9ebdd2f74e38fe51ffd48c43326cbc'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ) } { my $rr = new Net::DNS::RR(". $type @data"); eval { $rr->certificate('123456789XBCDEF'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt hexadecimal\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-HINFO.t0000644000175000017500000000353713031240164013674 0ustar willemwillem# $Id: 05-HINFO.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 12; use Net::DNS; my $name = 'HINFO.example'; my $type = 'HINFO'; my $code = 13; my @attr = qw( cpu os ); my @data = qw( VAX-11/750 VMS ); my @also = qw( ); my $wire = '0a5641582d31312f37353003564d53'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/42-DNSKEY-flags.t0000644000175000017500000000225113031240164015111 0ustar willemwillem# $Id: 42-DNSKEY-flags.t 1367 2015-06-29 08:53:56Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Net::DNS::RR::DNSKEY; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 16; my $dnskey = new Net::DNS::RR <<'END'; RSASHA1.example. IN DNSKEY 256 3 5 ( AwEAAZHbngk6sMoFHN8fsYY6bmGR4B9UYJIqDp+mORLEH53Xg0f6RMDtfx+H3/x7bHTUikTr26bV AqsxOs2KxyJ2Xx9RGG0DB9O4gpANljtTq2tLjvaQknhJpSq9vj4CqUtr6Wu152J2aQYITBoQLHDV i8mIIunparIKDmhy8TclVXg9 ; Key ID = 1623 ) END ok( $dnskey, 'set up DNSKEY record' ); $dnskey->flags(0); foreach my $flag ( qw(sep zone revoke) ) { my $boolean = $dnskey->$flag(0); ok( !$boolean, "Boolean $flag flag has expected value" ); my $keytag = $dnskey->keytag; $dnskey->$flag( !$boolean ); ok( $dnskey->$flag, "Boolean $flag flag toggled" ); isnt( $dnskey->keytag, $keytag, "keytag recalculated using modified $flag flag" ); $dnskey->$flag($boolean); ok( !$dnskey->$flag, "Boolean $flag flag restored" ); is( $dnskey->keytag, $keytag, "keytag recalculated using restored $flag flag" ); } exit; __END__ Net-DNS-1.07/t/06-update.t0000644000175000017500000002001513031240164014302 0ustar willemwillem# $Id: 06-update.t 1408 2015-10-06 20:35:56Z willem $ -*-perl-*- use strict; use Test::More tests => 84; use Net::DNS; sub is_empty { local $_ = shift; return 0 unless defined $_; return 1 unless length $_; return 1 if /\\# 0/; return 1 if /; no data/; return 1 if /; rdlength = 0/; return 0; } #------------------------------------------------------------------------------ # Canned data. #------------------------------------------------------------------------------ my $zone = "example.com"; my $name = "foo.example.com"; my $class = "HS"; my $class2 = "CH"; my $type = "A"; my $ttl = 43200; my $rdata = "10.1.2.3"; #------------------------------------------------------------------------------ # Packet creation. #------------------------------------------------------------------------------ { my $packet = new Net::DNS::Update( $zone, $class ); my ($z) = ( $packet->zone )[0]; ok( $packet, 'new() returned packet' ); is( $packet->header->opcode, 'UPDATE', 'header opcode correct' ); is( $z->zname, $zone, 'zname correct' ); is( $z->zclass, $class, 'zclass correct' ); is( $z->ztype, 'SOA', 'ztype correct' ); } { local $ENV{'LOCALDOMAIN'}; # overides config files my $packet = eval { new Net::DNS::Update(undef); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "argument undefined\t[$exception]" ); } #------------------------------------------------------------------------------ # RRset exists (value-independent). #------------------------------------------------------------------------------ { my $arg = "$name $ttl $class $type"; my $rr = yxrrset($arg); ok( $rr, "yxrrset($arg)" ); #9 is( $rr->name, $name, 'yxrrset - right name' ); is( $rr->ttl, 0, 'yxrrset - ttl 0' ); is( $rr->class, 'ANY', 'yxrrset - class ANY' ); is( $rr->type, $type, "yxrrset - type $type" ); ok( is_empty( $rr->rdstring ), 'yxrrset - data empty' ); } #------------------------------------------------------------------------------ # RRset exists (value-dependent). #------------------------------------------------------------------------------ { my $arg = "$name $ttl $class $type $rdata"; my $rr = yxrrset($arg); ok( $rr, "yxrrset($arg)" ); is( $rr->name, $name, 'yxrrset - right name' ); is( $rr->ttl, 0, 'yxrrset - ttl 0' ); is( $rr->class, $class, "yxrrset - class $class" ); is( $rr->type, $type, "yxrrset - type $type" ); is( $rr->rdstring, $rdata, 'yxrrset - right data' ); } #------------------------------------------------------------------------------ # RRset does not exist. #------------------------------------------------------------------------------ { my $arg = "$name $ttl $class $type $rdata"; my $rr = nxrrset($arg); ok( $rr, "nxrrset($arg)" ); #21 is( $rr->name, $name, 'nxrrset - right name' ); is( $rr->ttl, 0, 'nxrrset - ttl 0' ); is( $rr->class, 'NONE', 'nxrrset - class NONE' ); is( $rr->type, $type, "nxrrset - type $type" ); ok( is_empty( $rr->rdstring ), 'nxrrset - data empty' ); } #------------------------------------------------------------------------------ # Name is in use. #------------------------------------------------------------------------------ { my @arg = "$name"; my $rr = yxdomain(@arg); ok( $rr, "yxdomain(@arg)" ); #27 is( $rr->name, $name, 'yxdomain - right name' ); is( $rr->ttl, 0, 'yxdomain - ttl 0' ); is( $rr->class, 'ANY', 'yxdomain - class ANY' ); is( $rr->type, 'ANY', 'yxdomain - type ANY' ); ok( is_empty( $rr->rdstring ), 'yxdomain - data empty' ); } { my @arg = ( name => $name ); my $rr = yxdomain(@arg); ok( $rr, "yxdomain(@arg)" ); is( $rr->name, $name, 'yxdomain - right name' ); is( $rr->ttl, 0, 'yxdomain - ttl 0' ); is( $rr->class, 'ANY', 'yxdomain - class ANY' ); is( $rr->type, 'ANY', 'yxdomain - type ANY' ); ok( is_empty( $rr->rdstring ), 'yxdomain - data empty' ); } #------------------------------------------------------------------------------ # Name is not in use. #------------------------------------------------------------------------------ { my @arg = "$name"; my $rr = nxdomain(@arg); ok( $rr, "nxdomain(@arg)" ); #39 is( $rr->name, $name, 'nxdomain - right name' ); is( $rr->ttl, 0, 'nxdomain - ttl 0' ); is( $rr->class, 'NONE', 'nxdomain - class NONE' ); is( $rr->type, 'ANY', 'nxdomain - type ANY' ); ok( is_empty( $rr->rdstring ), 'nxdomain - data empty' ); } { my @arg = ( name => $name ); my $rr = nxdomain(@arg); ok( $rr, "nxdomain(@arg)" ); is( $rr->name, $name, 'nxdomain - right name' ); is( $rr->ttl, 0, 'nxdomain - ttl 0' ); is( $rr->class, 'NONE', 'nxdomain - class NONE' ); is( $rr->type, 'ANY', 'nxdomain - type ANY' ); ok( is_empty( $rr->rdstring ), 'nxdomain - data empty' ); } #------------------------------------------------------------------------------ # Add to an RRset. #------------------------------------------------------------------------------ { my $arg = "$name $ttl $class $type $rdata"; my $rr = rr_add($arg); ok( $rr, "rr_add($arg)" ); #51 is( $rr->name, $name, 'rr_add - right name' ); is( $rr->ttl, $ttl, "rr_add - ttl $ttl" ); is( $rr->class, $class, "rr_add - class $class" ); is( $rr->type, $type, "rr_add - type $type" ); is( $rr->rdstring, $rdata, 'rr_add - right data' ); } { my $arg = "$name $class $type $rdata"; my $rr = rr_add($arg); ok( $rr, "rr_add($arg)" ); is( $rr->name, $name, 'rr_add - right name' ); is( $rr->ttl, 86400, "rr_add - ttl 86400" ); is( $rr->class, $class, "rr_add - class $class" ); is( $rr->type, $type, "rr_add - type $type" ); is( $rr->rdstring, $rdata, 'rr_add - right data' ); } #------------------------------------------------------------------------------ # Delete an RRset. #------------------------------------------------------------------------------ { my $arg = "$name $class $type"; my $rr = rr_del($arg); ok( $rr, "rr_del($arg)" ); #63 is( $rr->name, $name, 'rr_del - right name' ); is( $rr->ttl, 0, 'rr_del - ttl 0' ); is( $rr->class, 'ANY', 'rr_del - class ANY' ); is( $rr->type, $type, "rr_del - type $type" ); ok( is_empty( $rr->rdstring ), 'rr_del - data empty' ); } #------------------------------------------------------------------------------ # Delete All RRsets From A Name. #------------------------------------------------------------------------------ { my $arg = "$name"; my $rr = rr_del($arg); ok( $rr, "rr_del($arg)" ); is( $rr->name, $name, 'rr_del - right name' ); is( $rr->ttl, 0, 'rr_del - ttl 0' ); is( $rr->class, 'ANY', 'rr_del - class ANY' ); is( $rr->type, 'ANY', 'rr_del - type ANY' ); ok( is_empty( $rr->rdstring ), 'rr_del - data empty' ); } #------------------------------------------------------------------------------ # Delete An RR From An RRset. #------------------------------------------------------------------------------ { my $arg = "$name $class $type $rdata"; my $rr = rr_del($arg); ok( $rr, "rr_del($arg)" ); is( $rr->name, $name, 'rr_del - right name' ); is( $rr->ttl, 0, 'rr_del - ttl 0' ); is( $rr->class, 'NONE', 'rr_del - class NONE' ); is( $rr->type, $type, "rr_del - type $type" ); is( $rr->rdstring, $rdata, 'rr_del - right data' ); } #------------------------------------------------------------------------------ # Make sure RRs in an update packet have the same class as the zone, unless # the class is NONE or ANY. #------------------------------------------------------------------------------ { my $packet = Net::DNS::Update->new( $zone, $class ); ok( $packet, 'packet created' ); #81 $packet->push( "pre", yxrrset("$name $class $type $rdata") ); $packet->push( "pre", yxrrset("$name $class2 $type $rdata") ); $packet->push( "pre", yxrrset("$name $class2 $type") ); $packet->push( "pre", nxrrset("$name $class2 $type") ); my @pre = $packet->pre; is( scalar(@pre), 4, '"pre" length correct' ); is( $pre[0]->class, $class, 'first class right' ); is( $pre[1]->class, $class, 'second class right' ); is( $pre[2]->class, 'ANY', 'third class right' ); is( $pre[3]->class, 'NONE', 'fourth class right' ); } Net-DNS-1.07/t/05-NSEC.t0000644000175000017500000000531413031240164013554 0ustar willemwillem# $Id: 05-NSEC.t 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- use strict; use Test::More tests => 16; use Net::DNS; my $name = 'alpha.example.com'; my $type = 'NSEC'; my $code = 47; my @attr = qw( nxtdname typelist); my @data = qw( host.example.com A MX RRSIG NSEC TYPE1234 ); my @hash = ( qw( host.example.com ), q(A MX NSEC RRSIG TYPE1234) ); my @also = qw( ); my $wire = '04686f7374076578616d706c6503636f6d000006400100000003041b000000000000000000000000000000000000000000000000000020'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @hash; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { my $a = join ' ', sort split /\s+/, $rr->$_; # typelist order unspecified my $b = join ' ', sort split /\s+/, $hash->{$_}; is( $a, $b, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( !length $compressed < length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR(". $type"); $rr->typebm(''); is( $rr->typebm(), '', "historical 'typebm'" ); } exit; Net-DNS-1.07/t/05-TSIG.t0000644000175000017500000004063713031240164013601 0ustar willemwillem# $Id: 05-TSIG.t 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::HMAC Digest::MD5 Digest::SHA MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 68; sub mysign { my ( $key, $data ) = @_; my $hmac = new Digest::HMAC( $key, 'Digest::MD5' ); $hmac->add($data); return $hmac->digest; } my $name = '123456789-test'; my $type = 'TSIG'; my $code = 250; my @attr = qw( algorithm time_signed fudge sig_function ); my @data = ( qw( fake.alg 100001 600 ), \&mysign ); my @also = qw( mac prior_mac request_mac error sign_func other_data _size ); my $wire = '0466616b6503616c67000000000186a102580010a5d31d3ce3b7122b4a598c225d9c3f2a04d200000000'; my $hash = {}; @{$hash}{@attr} = @data; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash, keybin => 'fake key', ); my $string = $rr->string; like( $rr->string, "/$$hash{algorithm}/", 'got expected rr->string' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { ok( defined $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $buffer = $empty; ## Note: TSIG RR gets destroyed by decoder my $rxbin = decode Net::DNS::RR( \$buffer )->encode; my $packet = Net::DNS::Packet->new( $name, 'TKEY', 'IN' ); $packet->header->id(1234); # fix packet id $packet->header->rd(1); my $encoded = $buffer = $rr->encode( 0, {}, $packet ); my $decoded = decode Net::DNS::RR( \$buffer ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); my @wire = unpack 'C*', $encoded; my $wireformat = pack 'C*', @wire, 0; eval { decode Net::DNS::RR( \$wireformat ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "misplaced SIG RR\t[$exception]" ); } { my $rr = new Net::DNS::RR( type => 'TSIG', key => '' ); ok( !$rr->verify(), 'verify fails on empty TSIG' ); ok( $rr->vrfyerrstr(), 'vrfyerrstr() reports failure' ); ok( !$rr->other(), 'other undefined' ); ok( $rr->time_signed(), 'time_signed() defined' ); my $key = eval { $rr->key(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "write-only key attribute\t[$exception]" ); } { my $correct = '123456789ABCDEF'; my $corrupt = '123456789XBCDEF'; foreach my $method (qw(mac request_mac prior_mac)) { my $rr = new Net::DNS::RR( type => 'TSIG', $method => $correct ); ok( $rr->$method($correct), "correct hex $method" ); eval { $rr->$method($corrupt); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt hex $method\t[$exception]" ); } } { # Check default signing function using test cases from RFC2202, section 2. my $tsig = new Net::DNS::RR( type => 'TSIG', fudge => 300 ); my $function = $tsig->sig_function; # default signing function my $algorithm = $tsig->algorithm; # default algorithm is( $algorithm, 'HMAC-MD5.SIG-ALG.REG.INT', 'Check algorithm correctly identified' ); { my $key = "\x0b" x 16; my $data = "Hi There"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '9294727a3638bb1c13f48ef8158bfc9d'; is( $result, $expect, "Check signing function for $algorithm" ); } { my $key = "Jefe"; my $data = "what do ya want for nothing?"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '750c783e6ab0b503eaa86e310a5db738'; is( $result, $expect, "Check $algorithm with key shorter than hash size" ); } { my $key = "\xaa" x 16; my $data = "\xdd" x 50; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '56be34521d144c88dbb8c733f0e8b3f6'; is( $result, $expect, "Check $algorithm with data longer than hash size" ); } { my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819'; my $data = "\xcd" x 50; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '697eaf0aca3a3aea3a75164746ffaa79'; is( $result, $expect, "Check $algorithm with key and data longer than hash" ); } { my $key = "\xaa" x 80; my $data = "Test Using Larger Than Block-Size Key - Hash Key First"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd'; is( $result, $expect, "Check $algorithm with key longer than block size" ); } { my $key = "\xaa" x 80; my $data = "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '6f630fad67cda0ee1fb1f562db3aa53e'; is( $result, $expect, "Check $algorithm with both long key and long data" ); } } { # Check HMAC-SHA1 signing function using test cases from RFC2202, section 3. my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA' ); # alias HMAC-SHA1 my $algorithm = $tsig->algorithm; my $function = $tsig->sig_function; is( $algorithm, 'HMAC-SHA1', 'Check algorithm correctly identified' ); { my $key = "\x0b" x 20; my $data = "Hi There"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'b617318655057264e28bc0b6fb378c8ef146be00'; is( $result, $expect, "Check signing function for $algorithm" ); } { my $key = "Jefe"; my $data = "what do ya want for nothing?"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'effcdf6ae5eb2fa2d27416d5f184df9c259a7c79'; is( $result, $expect, "Check $algorithm with key shorter than hash size" ); } { my $key = "\xaa" x 20; my $data = "\xdd" x 50; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '125d7342b9ac11cd91a39af48aa17b4f63f175d3'; is( $result, $expect, "Check $algorithm with data longer than hash size" ); } { my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819'; my $data = "\xcd" x 50; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = '4c9007f4026250c6bc8414f9bf50c86c2d7235da'; is( $result, $expect, "Check $algorithm with key and data longer than hash" ); } { my $key = "\xaa" x 80; my $data = "Test Using Larger Than Block-Size Key - Hash Key First"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'aa4ae5e15272d00e95705637ce8a3b55ed402112'; is( $result, $expect, "Check $algorithm with key longer than block size" ); } { my $key = "\xaa" x 80; my $data = "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"; my $result = lc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'e8e99d0f45237d786d6bbaa7965c7808bbff1a91'; is( $result, $expect, "Check $algorithm with both long key and long data" ); } } { # Check HMAC-SHA224 signing function using test cases from RFC4634, section 8.4. my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 162 ); # alias HMAC-SHA224 my $algorithm = $tsig->algorithm; my $function = $tsig->sig_function; is( $algorithm, 'HMAC-SHA224', 'Check algorithm correctly identified' ); { my $key = "\x0b" x 20; my $data = "Hi There"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '896FB1128ABBDF196832107CD49DF33F47B4B1169912BA4F53684B22'; is( $result, $expect, "Check signing function for $algorithm" ); } { my $key = "Jefe"; my $data = "what do ya want for nothing?"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'A30E01098BC6DBBF45690F3A7E9E6D0F8BBEA2A39E6148008FD05E44'; is( $result, $expect, "Check $algorithm with key shorter than hash size" ); } { my $key = "\xaa" x 20; my $data = "\xdd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '7FB3CB3588C6C1F6FFA9694D7D6AD2649365B0C1F65D69D1EC8333EA'; is( $result, $expect, "Check $algorithm with data longer than hash size" ); } { my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819'; my $data = "\xcd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '6C11506874013CAC6A2ABC1BB382627CEC6A90D86EFC012DE7AFEC5A'; is( $result, $expect, "Check $algorithm with key and data longer than hash" ); } { my $key = "\xaa" x 131; my $data = "Test Using Larger Than Block-Size Key - Hash Key First"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '95E9A0DB962095ADAEBE9B2D6F0DBCE2D499F112F2D2B7273FA6870E'; is( $result, $expect, "Check $algorithm with key longer than block size" ); } { my $key = "\xaa" x 131; my $data = "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '3A854166AC5D9F023F54D517D0B39DBD946770DB9C2B95C9F6F565D1'; is( $result, $expect, "Check $algorithm with both long key and long data" ); } } { # Check HMAC-SHA256 signing function using test cases from RFC4634, section 8.4. my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA256' ); my $algorithm = $tsig->algorithm; my $function = $tsig->sig_function; { my $key = "\x0b" x 20; my $data = "Hi There"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'B0344C61D8DB38535CA8AFCEAF0BF12B881DC200C9833DA726E9376C2E32CFF7'; is( $result, $expect, "Check signing function for $algorithm" ); } { my $key = "Jefe"; my $data = "what do ya want for nothing?"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '5BDCC146BF60754E6A042426089575C75A003F089D2739839DEC58B964EC3843'; is( $result, $expect, "Check $algorithm with key shorter than hash size" ); } { my $key = "\xaa" x 20; my $data = "\xdd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '773EA91E36800E46854DB8EBD09181A72959098B3EF8C122D9635514CED565FE'; is( $result, $expect, "Check $algorithm with data longer than hash size" ); } { my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819'; my $data = "\xcd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '82558A389A443C0EA4CC819899F2083A85F0FAA3E578F8077A2E3FF46729665B'; is( $result, $expect, "Check $algorithm with key and data longer than hash" ); } { my $data = "Test Using Larger Than Block-Size Key - Hash Key First"; my $output = &$function( "\xaa" x 131, $data ); my $result = uc unpack( 'H*', $output ); my $expect = '60E431591EE0B67F0D8A26AACBF5B77F8E0BC6213728C5140546040F0EE37F54'; is( $result, $expect, "Check $algorithm with key longer than block size" ); } { my $data = "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."; my $output = &$function( "\xaa" x 131, $data ); my $result = uc unpack( 'H*', $output ); my $expect = '9B09FFA71B942FCB27635FBCD5B0E944BFDC63644F0713938A7F51535C3A35E2'; is( $result, $expect, "Check $algorithm with both long key and long data" ); } } { # Check HMAC-SHA384 signing function using test cases from RFC4634, section 8.4. my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA384' ); my $algorithm = $tsig->algorithm; my $function = $tsig->sig_function; { my $key = "\x0b" x 20; my $data = "Hi There"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'AFD03944D84895626B0825F4AB46907F15F9DADBE4101EC682AA034C7CEBC59CFAEA9EA9076EDE7F4AF152E8B2FA9CB6'; is( $result, $expect, "Check signing function for $algorithm" ); } { my $key = "Jefe"; my $data = "what do ya want for nothing?"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'AF45D2E376484031617F78D2B58A6B1B9C7EF464F5A01B47E42EC3736322445E8E2240CA5E69E2C78B3239ECFAB21649'; is( $result, $expect, "Check $algorithm with key shorter than hash size" ); } { my $key = "\xaa" x 20; my $data = "\xdd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '88062608D3E6AD8A0AA2ACE014C8A86F0AA635D947AC9FEBE83EF4E55966144B2A5AB39DC13814B94E3AB6E101A34F27'; is( $result, $expect, "Check $algorithm with data longer than hash size" ); } { my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819'; my $data = "\xcd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '3E8A69B7783C25851933AB6290AF6CA77A9981480850009CC5577C6E1F573B4E6801DD23C4A7D679CCF8A386C674CFFB'; is( $result, $expect, "Check $algorithm with key and data longer than hash" ); } { my $data = "Test Using Larger Than Block-Size Key - Hash Key First"; my $output = &$function( "\xaa" x 131, $data ); my $result = uc unpack( 'H*', $output ); my $expect = '4ECE084485813E9088D2C63A041BC5B44F9EF1012A2B588F3CD11F05033AC4C60C2EF6AB4030FE8296248DF163F44952'; is( $result, $expect, "Check $algorithm with key longer than block size" ); } { my $data = "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."; my $output = &$function( "\xaa" x 131, $data ); my $result = uc unpack( 'H*', $output ); my $expect = '6617178E941F020D351E2F254E8FD32C602420FEB0B8FB9ADCCEBB82461E99C5A678CC31E799176D3860E6110C46523E'; is( $result, $expect, "Check $algorithm with both long key and long data" ); } } { # Check HMAC-SHA512 signing function using test cases from RFC4634, section 8.4. my $tsig = new Net::DNS::RR( type => 'TSIG', algorithm => 'HMAC-SHA512' ); my $algorithm = $tsig->algorithm; my $function = $tsig->sig_function; { my $key = "\x0b" x 20; my $data = "Hi There"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '87AA7CDEA5EF619D4FF0B4241A1D6CB02379F4E2CE4EC2787AD0B30545E17CDEDAA833B7D6B8A702038B274EAEA3F4E4BE9D914EEB61F1702E696C203A126854'; is( $result, $expect, "Check signing function for $algorithm" ); } { my $key = "Jefe"; my $data = "what do ya want for nothing?"; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = '164B7A7BFCF819E2E395FBE73B56E0A387BD64222E831FD610270CD7EA2505549758BF75C05A994A6D034F65F8F0E6FDCAEAB1A34D4A6B4B636E070A38BCE737'; is( $result, $expect, "Check $algorithm with key shorter than hash size" ); } { my $key = "\xaa" x 20; my $data = "\xdd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'FA73B0089D56A284EFB0F0756C890BE9B1B5DBDD8EE81A3655F83E33B2279D39BF3E848279A722C806B485A47E67C807B946A337BEE8942674278859E13292FB'; is( $result, $expect, "Check $algorithm with data longer than hash size" ); } { my $key = pack 'H*', '0102030405060708090a0b0c0d0e0f10111213141516171819'; my $data = "\xcd" x 50; my $result = uc unpack( 'H*', &$function( $key, $data ) ); my $expect = 'B0BA465637458C6990E5A8C5F61D4AF7E576D97FF94B872DE76F8050361EE3DBA91CA5C11AA25EB4D679275CC5788063A5F19741120C4F2DE2ADEBEB10A298DD'; is( $result, $expect, "Check $algorithm with key and data longer than hash" ); } { my $data = "Test Using Larger Than Block-Size Key - Hash Key First"; my $output = &$function( "\xaa" x 131, $data ); my $result = uc unpack( 'H*', $output ); my $expect = '80B24263C7C1A3EBB71493C1DD7BE8B49B46D1F41B4AEEC1121B013783F8F3526B56D037E05F2598BD0FD2215D6A1E5295E64F73F63F0AEC8B915A985D786598'; is( $result, $expect, "Check $algorithm with key longer than block size" ); } { my $data = "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."; my $output = &$function( "\xaa" x 131, $data ); my $result = uc unpack( 'H*', $output ); my $expect = 'E37B6A775DC87DBAA4DFA9F96E5E3FFDDEBD71F8867289865DF5A32D20CDC944B6022CAC3C4982B10D5EEB55C3E4DE15134676FB6DE0446065C97440FA8C6A58'; is( $result, $expect, "Check $algorithm with both long key and long data" ); } } exit; Net-DNS-1.07/t/05-TKEY.t0000644000175000017500000000434613031240164013604 0ustar willemwillem# $Id: 05-TKEY.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 24; use Net::DNS; my $name = 'TKEY.example'; my $type = 'TKEY'; my $code = 249; my @attr = qw( algorithm inception expiration mode error key other ); my @data = qw( alg.example 1434806118 1434806118 1 17 dummy dummy ); my @also = qw( other_data ); my $wire = '03616c67076578616d706c6500558567665585676600010011000564756d6d79000564756d6d79'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); my @wire = unpack 'C*', $encoded; $wire[length($empty) - 1]--; my $wireformat = pack 'C*', @wire; eval { decode Net::DNS::RR( \$wireformat ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-NSEC3.t0000644000175000017500000000644413031240164013644 0ustar willemwillem# $Id: 05-NSEC3.t 1389 2015-09-09 13:09:43Z willem $ -*-perl-*- # use strict; use Test::More tests => 26; use Net::DNS; my $name = '0p9mhaveqvm6t7vbl5lop2u3t2rp3tom.example'; my $type = 'NSEC3'; my $code = 50; my @attr = qw( algorithm flags iterations salt hnxtname typelist ); my @data = qw( 1 1 12 aabbccdd 2t7b4g4vsa5smi47k61mv5bv1a22bojr NS SOA MX RRSIG DNSKEY NSEC3PARAM ); my @hash = ( qw( 1 1 12 aabbccdd 2t7b4g4vsa5smi47k61mv5bv1a22bojr ), q(NS SOA MX RRSIG DNSKEY NSEC3PARAM) ); my @also = qw( hashalgo optout ); my $wire = '0101000c04aabbccdd14174eb2409fe28bcb4887a1836f957f0a8425e27b000722010000000290'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @hash; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { my $a = join ' ', sort split /\s+/, $rr->$_; # typelist order unspecified my $b = join ' ', sort split /\s+/, $hash->{$_}; is( $a, $b, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my @rdata = qw(1 1 12 - 2t7b4g4vsa5smi47k61mv5bv1a22bojr A); my $rr = new Net::DNS::RR(". $type @rdata"); my $class = ref($rr); $rr->algorithm('SHA-1'); is( $rr->algorithm(), 1, 'algorithm mnemonic accepted' ); is( $rr->algorithm('MNEMONIC'), 'SHA-1', "rr->algorithm('MNEMONIC')" ); is( $class->algorithm('SHA-1'), 1, "class method algorithm('SHA-1')" ); is( $class->algorithm(1), 'SHA-1', "class method algorithm(1)" ); is( $class->algorithm(255), 255, "class method algorithm(255)" ); eval { $rr->algorithm('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } { my @rdata = qw(1 1 12 - 2t7b4g4vsa5smi47k61mv5bv1a22bojr A); my $rr = new Net::DNS::RR(". $type @rdata"); is( $rr->salt, '', 'parse RR with salt field placeholder' ); is( $rr->rdstring, "@rdata", 'placeholder denotes empty salt field' ); is( unpack( 'H*', $rr->saltbin ), '', 'null salt binary value' ); eval { $rr->salt('123456789XBCDEF'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt hexadecimal\t[$exception]" ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-CERT.t0000644000175000017500000000576013031240164013566 0ustar willemwillem# $Id: 05-CERT.t 1390 2015-09-11 11:42:11Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 24; my $name = 'CERT.example'; my $type = 'CERT'; my $code = 37; my @attr = qw( certtype keytag algorithm cert ); my @data = qw( 1 2 3 MTIzNDU2Nzg5YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXo= ); my @also = qw( certificate format tag ); my $wire = '00010002033132333435363738396162636465666768696a6b6c6d6e6f707172737475767778797a'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { next if /certificate/; is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { is( Net::DNS::RR->new("foo IN CERT 0 2 3 foo=")->certtype, 0, 'certtype may be zero' ); is( Net::DNS::RR->new("foo IN CERT 1 0 3 foo=")->keytag, 0, 'keytag may be zero' ); is( Net::DNS::RR->new("foo IN CERT 1 2 0 foo=")->algorithm, 0, 'algorithm may be zero' ); is( Net::DNS::RR->new("foo IN CERT 1 2 3 '' ")->cert, '', 'cert may be empty' ); } { my $rr = Net::DNS::RR->new("foo IN CERT 1 2 3 foo="); is( $rr->algorithm('MNEMONIC'), 'DSA', 'algorithm mnemonic' ); $rr->algorithm(0); is( $rr->algorithm('MNEMONIC'), 0, 'algorithm with no mnemonic' ); eval { $rr->algorithm('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } { my $rr = Net::DNS::RR->new("foo IN CERT 1 2 3 foo="); is( $rr->certtype('PKIX'), 1, 'valid certtype mnemonic' ); eval { $rr->certtype('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } exit; Net-DNS-1.07/t/65-RRSIG-RSASHA1.t0000644000175000017500000001665013031240164014765 0ustar willemwillem# $Id: 65-RRSIG-RSASHA1.t 1392 2015-09-13 16:30:51Z willem $ -*-perl-*- # use strict; use Test::More; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::RSA Crypt::OpenSSL::Bignum Crypt::OpenSSL::RSA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 30; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; RSASHA1.example. IN DNSKEY 257 3 5 ( AwEAAefP0RzK3K39a5wznjeWA1PssI2dxqPb9SL+ppY8wcimOuEBmSJP5n6/bwg923VFlRiYJHe5 if4saxWCYenQ46hWz44sK943K03tfHkxo54ayAk/7dMj1wQ7Dby5FJ1AAMGZZO65BlKSD+2BTcwp IL9mAYuhHYfkG6FTEEKgHVmOVmtyKWA3gl3RrSSgXzTWnUS5b/jEeh2SflXG9eXabaoVXEHQN+oJ dTiAiErZW4+Zlx5pIrSycZBpIdWvn4t71L3ik6GctQqG9ln12j2ngji3blVI3ENMnUc237jUeYsy k7E5TughQctLYOFXHaeTMgJt0LUTyv3gIgDTRmvgQDU= ; Key ID = 4501 ) END ok( $ksk, 'set up RSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink($keyfile) if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.2 Algorithm: 5 (RSASHA1) Modulus: 58/RHMrcrf1rnDOeN5YDU+ywjZ3Go9v1Iv6mljzByKY64QGZIk/mfr9vCD3bdUWVGJgkd7mJ/ixrFYJh6dDjqFbPjiwr3jcrTe18eTGjnhrICT/t0yPXBDsNvLkUnUAAwZlk7rkGUpIP7YFNzCkgv2YBi6Edh+QboVMQQqAdWY5Wa3IpYDeCXdGtJKBfNNadRLlv+MR6HZJ+Vcb15dptqhVcQdA36gl1OICIStlbj5mXHmkitLJxkGkh1a+fi3vUveKToZy1Cob2WfXaPaeCOLduVUjcQ0ydRzbfuNR5izKTsTlO6CFBy0tg4Vcdp5MyAm3QtRPK/eAiANNGa+BANQ== PublicExponent: AQAB PrivateExponent: qVfDp4j61ZAAAMgkmO7Z14FdKNdNuX6CAeKNx8rytaXZ9W25dLtx4r3uWtL1cyI13RWn7l54VFoWkEwDQ0/6P4vLbE0QbvFWjUMkX1TH9kQSRc+R6WCRPuH1Ex0R1h5fbw6kEVDRMZjKUfLX5oFVDv1xu5Mjg5Y8KQoJIuLdDgHtRRV7ZETcGcSXBQ1eY2rNxui2YzM0mtqzApgGq7pLb3GfiM5aqW5fSdRaFajGC2VIXkN3jZYxAryT8EYJ6uRFJk0X3VegEwj6keHOem/tBV2DaNlv1JWidauPeU67evKNTQVW3h3AbQxnOtegdWrRKoa9Ksf27bgoKAlveHIfsQ== Prime1: +s1y+iP+AoB4UVS4S5njIZD21AWm36JTaqEvRPdevjuzc9q7yJATROdRdcAitdSPHeRC8xtQw/C9zGhJRdynlxfmUTeyYgM0EYHYiG7PLwkW5Wu9EeXJ7/Fpct51L+ednloQ0d7tYP/5QUd6cqbFGGKH0yF5zZMO0k+ZZ/saeCs= Prime2: 7J2eVZ5Psue4BTNya8PMA89cC0Gf51zFeQ8dPBZIOpN28DJN2EN6C6fwGtnr6BO+M/6loXzcekPGgRkpNcQ6MzJup8hZQmU8RxESAMlmQzOtaBbtmMwPa0p6IcZBUWpbRaKwQ4ZjAUS9R13PFwgEU+a855o0XRRTupdmyZ6OmR8= Exponent1: nGakbdMmIx9EaMuhRhwIJTWGhz+jCdDrnhI4LRTqM019oiDke7VFHvH1va18t9F/Ek/3ZC1Dl304jxD1qKhqpnGUAk/uYOrIfKZxhts7PoS3j4g5VsDqxkPQ035gq+gPReG6nXYcqCHYqVnOxVK0lHlVZFd64rTzSDm1W7+eiRM= Exponent2: evAuKygVGsxghXtEkQ9rOfOMTGDtdyVxiMO8mdKt9plV69kHLz1n9RRtoVXmx28ynQtK/YvFdlUulzb+fWwWHTGv4scq8V9uITKSWwxJcNMx3upCyugDfuh0aoX6vBV5lMXBtWPmnusbOTBZgArvTLSPI/qwCEiedE1j34/dYVs= Coefficient: JTEzUDflC+G0if7uqsJ2sw/x2aCHMjsCxYSmx2bJOW/nhQTQpzafL0N8E6WmKuEP4qAaqQjWrDyxy0XcAJrfcojJb+a3j2ndxYpev7Rq8f7P6M7qqVL0Nzj9rWFH7pyvWMnH584viuhPcDogy8ymHpNNuAF+w98qjnGD8UECiV4= END close(KSK); my $bad1 = new Net::DNS::RR <<'END'; RSASHA1.example. IN DNSKEY 256 3 5 ( AwEAAZHbngk6sMoFHN8fsYY6bmGR4B9UYJIqDp+mORLEH53Xg0f6RMDtfx+H3/x7bHTUikTr26bV AqsxOs2KxyJ2Xx9RGG0DB9O4gpANljtTq2tLjvaQknhJpSq9vj4CqUtr6Wu152J2aQYITBoQLHDV i8mIIunparIKDmhy8TclVXg9 ; Key ID = 1623 ) END my $bad2 = new Net::DNS::RR <<'END'; ECDSAP256SHA256.example. IN DNSKEY ( 256 3 13 7Y4BZY1g9uzBwt3OZexWk7iWfkiOt0PZ5o7EMip0KBNxlBD+Z58uWutYZIMolsW8v/3rfgac45lO IikBZK4KZg== ; Key ID = 44222 ) END my @rrset = ( $bad1, $ksk ); my @badrrset = ($bad1); { my $object = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $object->sig(), 'create RRSIG over rrset using private ksk' ); my $verified = $object->verify( \@rrset, $ksk ); ok( $verified, 'verify using public ksk' ); is( $object->vrfyerrstr, '', 'observe no object->vrfyerrstr' ); } { my $object = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); my $verified = $object->verify( \@badrrset, $bad1 ); ok( !$verified, 'verify fails using wrong key' ); ok( $object->vrfyerrstr, 'observe rrsig->vrfyerrstr' ); } { my $object = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); my $verified = $object->verify( \@badrrset, $bad2 ); ok( !$verified, 'verify fails using key with wrong algorithm' ); ok( $object->vrfyerrstr, 'observe rrsig->vrfyerrstr' ); } { my $object = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); my $verified = $object->verify( \@rrset, [$bad1, $bad2, $ksk] ); ok( $verified, 'verify using array of keys' ); is( $object->vrfyerrstr, '', 'observe no rrsig->vrfyerrstr' ); } { my $object = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); my $verified = $object->verify( \@badrrset, [$bad1, $bad2, $ksk] ); ok( !$verified, 'verify fails using wrong rrset' ); ok( $object->vrfyerrstr, 'observe rrsig->vrfyerrstr' ); } { my $wild = new Net::DNS::RR('*.example. A 10.1.2.3'); my $match = new Net::DNS::RR('leaf.twig.example. A 10.1.2.3'); my $object = create Net::DNS::RR::RRSIG( [$wild], $keyfile ); my $verified = $object->verify( [$match], $ksk ); ok( $verified, 'wildcard matches child domain name' ); is( $object->vrfyerrstr, '', 'observe no rrsig->vrfyerrstr' ); } { my $wild = new Net::DNS::RR('*.example. A 10.1.2.3'); my $bogus = new Net::DNS::RR('example. A 10.1.2.3'); my $object = create Net::DNS::RR::RRSIG( [$wild], $keyfile ); my $verified = $object->verify( [$bogus], $ksk ); ok( !$verified, 'wildcard does not match parent domain' ); ok( $object->vrfyerrstr, 'observe rrsig->vrfyerrstr' ); } { my $time = time() + 3; my %args = ( siginception => $time, sigexpiration => $time, ); my $object = create Net::DNS::RR::RRSIG( \@rrset, $keyfile, %args ); ok( !$object->verify( \@rrset, $ksk ), 'verify fails for postdated RRSIG' ); ok( $object->vrfyerrstr, 'observe rrsig->vrfyerrstr' ); sleep 1 until $time < time(); ok( !$object->verify( \@rrset, $ksk ), 'verify fails for expired RRSIG' ); ok( $object->vrfyerrstr, 'observe rrsig->vrfyerrstr' ); } { my $object = new Net::DNS::RR( type => 'RRSIG' ); my $class = ref($object); my $array = []; my $dnskey = new Net::DNS::RR( type => 'DNSKEY' ); my $private = new Net::DNS::SEC::Private($keyfile); my $packet = new Net::DNS::Packet(); my $rr1 = new Net::DNS::RR( name => 'example', type => 'A' ); my $rr2 = new Net::DNS::RR( name => 'differs', type => 'A' ); my $rr3 = new Net::DNS::RR( type => 'A', ttl => 1 ); my $rr4 = new Net::DNS::RR( type => 'A', ttl => 2 ); my $rr5 = new Net::DNS::RR( class => 'IN', type => 'A' ); my $rr6 = new Net::DNS::RR( class => 'ANY', type => 'A' ); my $rr7 = new Net::DNS::RR( type => 'A' ); my $rr8 = new Net::DNS::RR( type => 'AAAA' ); my @testcase = ( ## test create() with invalid arguments [$dnskey, $dnskey], [$array, $private], [[$rr1, $rr2], $private], [[$rr3, $rr4], $private], [[$rr5, $rr6], $private], [[$rr7, $rr8], $private], ); foreach my $arglist (@testcase) { my @argtype = map ref($_), @$arglist; eval { $class->create(@$arglist); }; my $exception = $1 if $@ =~ /^(.*)\n*/; ok( defined $exception, "create(@argtype)\t[$exception]" ); } } { my $object = new Net::DNS::RR( type => 'RRSIG' ); my $packet = new Net::DNS::Packet(); my $dnskey = new Net::DNS::RR( type => 'DNSKEY' ); my $dsrec = new Net::DNS::RR( type => 'DS' ); my $scalar = 'SCALAR'; my @testcase = ( ## test verify() with invalid arguments [$packet, $dnskey], [$dnskey, $dsrec], [$dnskey, $scalar], ); foreach my $arglist (@testcase) { my @argtype = map ref($_) || $_, @$arglist; eval { $object->verify(@$arglist); }; my $exception = $1 if $@ =~ /^(.*)\n*/; ok( defined $exception, "verify(@argtype)\t[$exception]" ); } } exit; __END__ Net-DNS-1.07/t/05-NS.t0000644000175000017500000000443313031240164013345 0ustar willemwillem# $Id: 05-NS.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 13; use Net::DNS; my $name = 'NS.example'; my $type = 'NS'; my $code = 2; my @attr = qw( nsdname ); my @data = qw( ns.example.com ); my @also = qw( ); my $wire = '026e73076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed < length $predecessor, 'encoded RDATA compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/74-RRSIG-ECDSAP384SHA384.t0000644000175000017500000000343113031240164015705 0ustar willemwillem# $Id: 74-RRSIG-ECDSAP384SHA384.t 1360 2015-06-15 09:58:53Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Time::Local Net::DNS::RR::RRSIG Net::DNS::SEC Net::DNS::SEC::ECDSA Crypt::OpenSSL::Bignum Crypt::OpenSSL::EC Crypt::OpenSSL::ECDSA Digest::SHA ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 7; use_ok('Net::DNS::SEC'); my $ksk = new Net::DNS::RR <<'END'; ECDSAP384SHA384.example. IN DNSKEY 257 3 14 ( M7KQuXJ6te/ySDoqb6KKh6KJEtlkGrRN1fr3ECqG9/cF7wZLMj+HuW6zh3rq1D9Pz7ycOB7ODxgj bq5eSFTCcGUqlNiE5gw4VoFSJE1zS5VQPUj0O35kgnJtfiT5hzr3 ; Key ID = 23772 ) END ok( $ksk, 'set up ECDSA public ksk' ); my $keyfile = $ksk->privatekeyname; END { unlink $keyfile if defined $keyfile; } open( KSK, ">$keyfile" ) or die "$keyfile $!"; print KSK <<'END'; Private-key-format: v1.2 Algorithm: 14 (ECDSAP384SHA384) PrivateKey: PYm2xD5F4AGcefONoEQkGYGIO/Ur6HNWJOETACal/ZEnCimviFyvrJ1hFmgz5zaQ END close(KSK); my $key = new Net::DNS::RR <<'END'; ECDSAP384SHA384.example. IN DNSKEY 256 3 14 ( 2lG4/insv7kKxX9QzQUzgnyneD7ZbPVSnjgI6jfmfdTHtnxHuKEnbgX7QQubj/YGA+Fpc86Lj0cp zDxLFwHgNJwJ0qjIXXfwTWiwkuNiShQPPVvF06iMyVpyoZntC7cc ; Key ID = 38753 ) END ok( $key, 'set up ECDSA public key' ); my @rrset = ( $key, $ksk ); my $rrsig = create Net::DNS::RR::RRSIG( \@rrset, $keyfile ); ok( $rrsig, 'create RRSIG over rrset using private ksk' ); my $verify = $rrsig->verify( \@rrset, $ksk ); ok( $verify, 'verify RRSIG using ksk' ) || diag $rrsig->vrfyerrstr; ok( !$rrsig->verify( \@rrset, $key ), 'verify fails using wrong key' ); my @badrrset = ($key); ok( !$rrsig->verify( \@badrrset, $ksk ), 'verify fails using wrong rrset' ); exit; __END__ Net-DNS-1.07/t/05-SOA.t0000644000175000017500000001037213031240164013446 0ustar willemwillem# $Id: 05-SOA.t 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- use strict; use Test::More tests => 40; use Net::DNS; my $name = 'SOA.example'; my $type = 'SOA'; my $code = 6; my @attr = qw( mname rname serial refresh retry expire minimum ); my @data = qw( ns.example.net rp@example.com 0 14400 1800 604800 7200 ); my @also = qw( ); my $wire = '026e73076578616d706c65036e657400027270076578616d706c6503636f6d0000000000000038400000070800093a8000001c20'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed < length $predecessor, 'encoded RDATA compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { use integer; my $initial = -1; ## exercise 32-bit compatibility code on 64-bit hardware foreach my $serial ( 2E9, 3E9, 4E9, 1E9, 2E9, 4E9, 1E9, 3E9 ) { my $rr = new Net::DNS::RR("name SOA mname rname $initial"); $rr->serial($serial); is( $rr->serial, 0 + $serial, "rr->serial($serial) steps from $initial to $serial" ); $initial = $serial; } } { use integer; my $rr = new Net::DNS::RR('name SOA mname rname 1'); my $initial = $rr->serial; $rr->serial(SEQUENTIAL); is( $rr->serial, ++$initial, 'rr->serial(SEQUENTIAL) increments existing serial number' ); my $pre31wrap = 0x7FFFFFFF; my $post31wrap = 0x80000000; $rr->serial($pre31wrap); $rr->serial(SEQUENTIAL); is( $rr->serial, 0 + $post31wrap, "rr->serial(SEQUENTIAL) wraps from $pre31wrap to $post31wrap" ); my $pre32wrap = 0xFFFFFFFF; my $post32wrap = 0x00000000; $rr->serial($pre32wrap); $rr->serial(SEQUENTIAL); is( $rr->serial, 0 + $post32wrap, "rr->serial(SEQUENTIAL) wraps from $pre32wrap to $post32wrap" ); } { use integer; my $rr = new Net::DNS::RR('name SOA mname rname 2000000000'); my $predate = $rr->serial; my $postdate = YYYYMMDDxx; my $postincr = $postdate + 1; is( $rr->serial($postdate), $postdate, "rr->serial(YYYYMMDDxx) steps from $predate to $postdate" ); is( $rr->serial($postdate), $postincr, "rr->serial(YYYYMMDDxx) increments $postdate to $postincr" ); } { use integer; my $pretime = UNIXTIME; my $rr = new Net::DNS::RR("name SOA mname rname $pretime"); sleep 5; my $posttime = UNIXTIME; my $postincr = $posttime + 1; is( $rr->serial($posttime), $posttime, "rr->serial(UNIXTIME) steps from $pretime to $posttime" ); is( $rr->serial($posttime), $postincr, "rr->serial(UNIXTIME) increments $posttime to $postincr" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->serial(YYYYMMDDxx); $rr->print; } exit; Net-DNS-1.07/t/05-AFSDB.t0000644000175000017500000000450313031240164013642 0ustar willemwillem# $Id: 05-AFSDB.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 15; use Net::DNS; my $name = 'AFSDB.example'; my $type = 'AFSDB'; my $code = 18; my @attr = qw( subtype hostname ); my @data = qw( 12345 host.example.com ); my @also = qw( ); my $wire = '303904686f7374076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-MX.t0000644000175000017500000000534113031240164013350 0ustar willemwillem# $Id: 05-MX.t 1354 2015-06-05 08:20:53Z willem $ -*-perl-*- use strict; use Test::More tests => 18; use Net::DNS; my $name = 'MX.example'; my $type = 'MX'; my $code = 15; my @attr = qw( preference exchange ); my @data = qw( 10 mx.example.com ); my @also = qw( ); my $wire = '000a026d78076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed < length $predecessor, 'encoded RDATA compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { ## incomplete RR (specimen test for widely used constructs) my $empty = new Net::DNS::RR( type => $type ); is( $empty->preference, 0, 'unspecified integer returns 0 (not default value)' ); is( $empty->exchange, undef, 'unspecified domain name returns undefined' ); my $part = new Net::DNS::RR( type => $type, exchange => 'mx.example' ); is( $part->preference, 10, 'unspecified integer returns default value' ); ok( $part->exchange, 'domain name defined as expected' ); is( $part->preference(0), 0, 'zero integer replaces default value' ); } exit; Net-DNS-1.07/t/02-mailbox.t0000644000175000017500000001116413031240164014454 0ustar willemwillem# $Id: 02-mailbox.t 1406 2015-10-05 08:25:49Z willem $ -*-perl-*- use strict; use Test::More tests => 43; BEGIN { use_ok('Net::DNS::Mailbox'); } { my $name = 'mbox@example.com'; my $mailbox = new Net::DNS::Mailbox($name); ok( $mailbox->isa('Net::DNS::Mailbox'), 'object returned by new() constructor' ); } { my $mailbox = eval { new Net::DNS::Mailbox(); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "empty argument list\t[$exception]" ); } { my $mailbox = eval { new Net::DNS::Mailbox(undef); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "argument undefined\t[$exception]" ); } { my %testcase = ( '.' => '<>', '<>' => '<>', 'a' => 'a', 'a.b' => 'a@b', 'a.b.c' => 'a@b.c', 'a.b.c.d' => 'a@b.c.d', 'a@b' => 'a@b', 'a@b.c' => 'a@b.c', 'a@b.c.d' => 'a@b.c.d', 'a\.b.c.d' => 'a.b@c.d', 'a\.b@c.d' => 'a.b@c.d', 'empty <>' => '<>', 'fore aft' => 'a.b@c.d', 'nested <
>' => 'address', 'obscure <<<>>>' => 'right', ); foreach my $test ( sort keys %testcase ) { my $expect = $testcase{$test}; my $mailbox = new Net::DNS::Mailbox($test); my $data = $mailbox->encode; my $decoded = decode Net::DNS::Mailbox( \$data ); is( $decoded->address, $expect, "encode/decode mailbox $test" ); } } { my %testcase = ( '"(a.b)"@c.d' => '"(a.b)"@c.d', '"[a.b]"@c.d' => '"[a.b]"@c.d', '"a,b"@c.d' => '"a,b"@c.d', '"a:b"@c.d' => '"a:b"@c.d', '"a;b"@c.d' => '"a;b"@c.d', '"a@b"@c.d' => '"a@b"@c.d', ); foreach my $test ( sort keys %testcase ) { my $expect = $testcase{$test}; my $mailbox = new Net::DNS::Mailbox($test); my $data = $mailbox->encode; my $decoded = decode Net::DNS::Mailbox( \$data ); is( $decoded->address, $expect, "encode/decode mailbox $test" ); } } { my $mailbox = new Net::DNS::Mailbox( uc 'MBOX.EXAMPLE.COM' ); my $hash = {}; my $data = $mailbox->encode( 1, $hash ); my $compress = $mailbox->encode( length $data, $hash ); my $canonical = $mailbox->encode( length $data ); my $decoded = decode Net::DNS::Mailbox( \$data ); my $downcased = new Net::DNS::Mailbox( lc $mailbox->name )->encode( 0, {} ); ok( $mailbox->isa('Net::DNS::Mailbox'), 'object returned by Net::DNS::Mailbox->new()' ); ok( $decoded->isa('Net::DNS::Mailbox'), 'object returned by Net::DNS::Mailbox->decode()' ); is( length $compress, length $data, 'Net::DNS::Mailbox encoding is uncompressed' ); isnt( $data, $downcased, 'Net::DNS::Mailbox encoding preserves case' ); is( length $canonical, length $data, 'Net::DNS::Mailbox canonical form is uncompressed' ); isnt( $canonical, $downcased, 'Net::DNS::Mailbox canonical form preserves case' ); } { my $mailbox = new Net::DNS::Mailbox1035( uc 'MBOX.EXAMPLE.COM' ); my $hash = {}; my $data = $mailbox->encode( 1, $hash ); my $compress = $mailbox->encode( length $data, $hash ); my $canonical = $mailbox->encode( length $data ); my $decoded = decode Net::DNS::Mailbox1035( \$data ); my $downcased = new Net::DNS::Mailbox1035( lc $mailbox->name )->encode( 0, {} ); ok( $mailbox->isa('Net::DNS::Mailbox1035'), 'object returned by Net::DNS::Mailbox1035->new()' ); ok( $decoded->isa('Net::DNS::Mailbox1035'), 'object returned by Net::DNS::Mailbox1035->decode()' ); isnt( length $compress, length $data, 'Net::DNS::Mailbox1035 encoding is compressible' ); isnt( $data, $downcased, 'Net::DNS::Mailbox1035 encoding preserves case' ); is( length $canonical, length $data, 'Net::DNS::Mailbox1035 canonical form is uncompressed' ); is( $canonical, $downcased, 'Net::DNS::Mailbox1035 canonical form is lower case' ); } { my $mailbox = new Net::DNS::Mailbox2535( uc 'MBOX.EXAMPLE.COM' ); my $hash = {}; my $data = $mailbox->encode( 1, $hash ); my $compress = $mailbox->encode( length $data, $hash ); my $canonical = $mailbox->encode( length $data ); my $decoded = decode Net::DNS::Mailbox2535( \$data ); my $downcased = new Net::DNS::Mailbox2535( lc $mailbox->name )->encode( 0, {} ); ok( $mailbox->isa('Net::DNS::Mailbox2535'), 'object returned by Net::DNS::Mailbox2535->new()' ); ok( $decoded->isa('Net::DNS::Mailbox2535'), 'object returned by Net::DNS::Mailbox2535->decode()' ); is( length $compress, length $data, 'Net::DNS::Mailbox2535 encoding is uncompressed' ); isnt( $data, $downcased, 'Net::DNS::Mailbox2535 encoding preserves case' ); is( length $canonical, length $data, 'Net::DNS::Mailbox2535 canonical form is uncompressed' ); is( $canonical, $downcased, 'Net::DNS::Mailbox2535 canonical form is lower case' ); } exit; Net-DNS-1.07/t/05-URI.t0000644000175000017500000000303413031240164013460 0ustar willemwillem# $Id: 05-URI.t 1390 2015-09-11 11:42:11Z willem $ -*-perl-*- use strict; use Test::More tests => 11; use Net::DNS; my $name = '_ftp._tcp.example.net'; my $type = 'URI'; my $code = 256; my @attr = qw( priority weight target ); my @data = qw( 10 1 ftp://ftp1.example.com/public ); my @also = qw( ); my $wire = '000A00016674703A2F2F667470312E6578616D706C652E636F6D2F7075626C6963'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name $type"); my $nodata = $empty->string; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-KEY.t0000644000175000017500000000401513031240164013451 0ustar willemwillem# $Id: 05-KEY.t 1354 2015-06-05 08:20:53Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 16; my $name = 'KEY.example'; my $type = 'KEY'; my $code = 25; my @attr = qw( flags protocol algorithm publickey ); my @data = ( 256, 3, 5, join '', qw( AQPSKmynfzW4kyBv015MUG2DeIQ3 Cbl+BBZH4b/0PY1kxkmvHjcZc8no kfzj31GajIQKY+5CptLr3buXA10h WqTkF7H6RfoRqXQeogmMHfpftf6z Mv1LyBUgia7za6ZEzOJBOztyvhjL 742iU/TpPSEDhm2SNKLijfUppn1U aNvv4w== ) ); my @also = qw( keybin keylength keytag privatekeyname zone revoke sep ); my $wire = join '', qw( 010003050103D22A6CA77F35B893206FD35E4C506D8378843709B97E041647E1 BFF43D8D64C649AF1E371973C9E891FCE3DF519A8C840A63EE42A6D2EBDDBB97 035D215AA4E417B1FA45FA11A9741EA2098C1DFA5FB5FEB332FD4BC8152089AE F36BA644CCE2413B3B72BE18CBEF8DA253F4E93D2103866D9234A2E28DF529A6 7D5468DBEFE3 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name NULL"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); } exit; Net-DNS-1.07/t/05-HIP.t0000644000175000017500000000771413031240164013452 0ustar willemwillem# $Id: 05-HIP.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 24; my $name = 'HIP.example'; my $type = 'HIP'; my $code = 55; my @attr = qw( pkalgorithm hit key servers ); my @data = qw( 2 200100107b1a74df365639cc39f1d578 AwEAAbdxyhNuSutc5EMzxTs9LBPCIkOFH8cIvM4p9+LrV4e19WzK00+CI6zBCQTdtWsuxKbWIy87UOoJTwkUs7lBu+Upr1gsNrut79ryra+bSRGQb1slImA8YVJyuIDsj7kwzG7jnERNqnWxZ48AWkskmdHaVDP4BcelrTI3rMXdXF5D rvs1.example.com rvs2.example.com ); my @also = qw( keybin ); my $wire = join '', qw( 10020084200100107b1a74df365639cc39f1d57803010001b771ca136e4aeb5c e44333c53b3d2c13c22243851fc708bcce29f7e2eb5787b5f56ccad34f8223ac c10904ddb56b2ec4a6d6232f3b50ea094f0914b3b941bbe529af582c36bbadef daf2adaf9b4911906f5b2522603c615272b880ec8fb930cc6ee39c444daa75b1 678f005a4b2499d1da5433f805c7a5ad3237acc5dd5c5e430472767331076578 616d706c6503636f6d000472767332076578616d706c6503636f6d00 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { next if /server/; is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } for (qw(servers)) { my ($rvs) = $rr->$_; # test limitation: single element list is( $rvs, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); my @wire = unpack 'C*', $encoded; $wire[length($empty) - 1]--; my $wireformat = pack 'C*', @wire; eval { decode Net::DNS::RR( \$wireformat ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type @data"); eval { $rr->hit('123456789XBCDEF'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt hexadecimal\t[$exception]" ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); is( $rr->pubkey, $rr->key, "historical 'pubkey'" ); is( ref( $rr->rendezvousservers ), 'ARRAY', "historical 'rendezvousservers'" ); $rr->print; } exit; Net-DNS-1.07/t/05-SPF.t0000644000175000017500000000356113031240164013456 0ustar willemwillem# $Id: 05-SPF.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 10; use Net::DNS; my $name = 'SPF.example'; my $type = 'SPF'; my $code = 99; my @attr = qw( spfdata ); my @data = ('v=spf1 +mx a:colo.example.com/28 -all'); my @also = qw( txtdata ); my $wire = '25763d73706631202b6d7820613a636f6c6f2e6578616d706c652e636f6d2f3238202d616c6c'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { my $r1 = join '', $rr->$_; is( $r1, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { my $r1 = join '', $rr->$_; my $r2 = join '', $rr2->$_; is( $r2, $r1, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } exit; Net-DNS-1.07/t/05-CAA.t0000644000175000017500000000406613031240164013413 0ustar willemwillem# $Id: 05-CAA.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 17; use Net::DNS; my $name = 'CAA.example'; my $type = 'CAA'; my $code = 257; my @attr = qw( flags tag value ); my @data = qw( 128 issue example.net ); my @also = qw( critical ); my $wire = '800569737375656578616d706c652e6e6574'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { next if /certificate/; is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } ok( $rr->critical(1), 'set $rr->critical' ); ok( !$rr->critical(0), 'clear $rr->critical' ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/43-DNSKEY-keylength.t0000644000175000017500000000434313031240164016014 0ustar willemwillem# $Id: 43-DNSKEY-keylength.t 1367 2015-06-29 08:53:56Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Net::DNS::RR::DNSKEY; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 9; my $rsa = new Net::DNS::RR <<'END'; RSASHA1.example. IN DNSKEY 256 3 5 ( AwEAAZHbngk6sMoFHN8fsYY6bmGR4B9UYJIqDp+mORLEH53Xg0f6RMDtfx+H3/x7bHTUikTr26bV AqsxOs2KxyJ2Xx9RGG0DB9O4gpANljtTq2tLjvaQknhJpSq9vj4CqUtr6Wu152J2aQYITBoQLHDV i8mIIunparIKDmhy8TclVXg9 ; Key ID = 1623 ) END ok( $rsa, 'set up RSA public key' ); is( $rsa->keylength, 1024, 'RSA keylength has expected value' ); my $longformat = pack 'xn a*', unpack 'C a*', $rsa->keybin; $rsa->keybin($longformat); is( $rsa->keylength, 1024, 'keylength for long format RSA key' ); my $dsa = new Net::DNS::RR <<'END'; DSA.example. IN DNSKEY 256 3 3 ( CMKzsCaT2Jy1w/sPdpigEE+nbeJ/x5C6cruWvStVum6/YulcR7MHeujx9c2iBDbo3kW4X8/l+qgk 7ZEZ+yV5lphWtJMmMtOHIU+YdAhgLpt84NKhcupWL8wfuBW/97cqIv5Z+51fwn0YEAcZsoCrE0nL 5+31VfkK9LTNuVo38hsbWa3eWZFalID5NesF6sJRgXZoAyeAH46EQVCq1UBnnaHslvSDkdb+Z1kT bMQ64ZVI/sBRXRbqIcDlXVZurCTDV7JL9KZwwfeyrQcnVyYh5mdHPsXbpX5NQJvoqPgvRZWBpP4h pjkAm9UrUbow9maPCQ1JQ3JuiU5buh9cjAI+QIyGMujKLT2OsogSZD2IFUciaZBL/rSe0gmAUv0q XrczmIYFUCoRGZ6+lKVqQQ6f2U7Gsr6zRbeJN+JCVD6BJ52zjLUaWUPHbakhZb/wMO7roX/tnA/w zoDYBIIF7yuRYWblgPXBJTK2Bp07xre8lKCRbzY4J/VXZFziZgHgcn9tkHnrfov04UG9zlWEdT6X E/60HjrP ; Key ID = 53244 ) END ok( $dsa, 'set up DSA public key' ); is( $dsa->keylength, 1024, 'DSA keylength has expected value' ); my $eccgost = new Net::DNS::RR <<'END'; ECC-GOST.example. IN DNSKEY 256 3 12 ( 6VwgNT1BXxXNVpTQXcJQ82PcsCYmI60oN88Plbl028ruvl6DqJby/uBGULHT5FXmZiXBJozE6kP0 +BirN9YPBQ== ; Key ID = 46387 ) END ok( $eccgost, 'set up ECC-GOST public key' ); is( $eccgost->keylength, 256, 'ECC-GOST keylength has expected value' ); my $ecdsa = new Net::DNS::RR <<'END'; ECDSAP256SHA256.example. IN DNSKEY 256 3 13 ( 7Y4BZY1g9uzBwt3OZexWk7iWfkiOt0PZ5o7EMip0KBNxlBD+Z58uWutYZIMolsW8v/3rfgac45lO IikBZK4KZg== ; Key ID = 44222 ) END ok( $ecdsa, 'set up ECDSA public key' ); is( $ecdsa->keylength, 256, 'ECDSA keylength has expected value' ); exit; __END__ Net-DNS-1.07/t/05-SRV.t0000644000175000017500000000453213031240164013477 0ustar willemwillem# $Id: 05-SRV.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 19; use Net::DNS; my $name = '_foo._tcp.example.com'; my $type = 'SRV'; my $code = 33; my @attr = qw( priority weight port target ); my @data = qw( 1 3 9 fast.example.com ); my @also = qw( ); my $wire = '0001000300090466617374076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-KX.t0000644000175000017500000000446413031240164013353 0ustar willemwillem# $Id: 05-KX.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 15; use Net::DNS; my $name = 'KX.example'; my $type = 'KX'; my $code = 36; my @attr = qw( preference exchange ); my @data = qw( 10 kx.example.com ); my @also = qw( ); my $wire = '000a026b78076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-NID.t0000644000175000017500000000354313031240164013440 0ustar willemwillem# $Id: 05-NID.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 12; use Net::DNS; my $name = 'NID.example'; my $type = 'NID'; my $code = 104; my @attr = qw( preference nodeid ); my @data = qw( 10 0014:4fff:ff20:ee64 ); my @also = qw( ); my $wire = '000a00144fffff20ee64'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-RRSIG.t0000644000175000017500000001416413031240164013715 0ustar willemwillem# $Id: 05-RRSIG.t 1406 2015-10-05 08:25:49Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Time::Local ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 70; my $name = 'net-dns.org'; my $type = 'RRSIG'; my $code = 46; my @attr = qw( typecovered algorithm labels orgttl sigexpiration siginception keytag signame signature ); my @data = ( qw( NS 7 2 3600 20130914141655 20130815141655 60909 net-dns.org ), join '', qw( IRlCjYNZCkddjoFw6UGxAga/EvxgENl+IESuyRH9vlrys yqne0gPpclC++raP3+yRA+gDIHrMkIwsLudqod4iuoA73 Mw1NxETS6lm2eQTDNzLSY6dnJxZBqXypC3Of7bF3UmR/G NhcFIThuV/qFq+Gs+g0TJ6eyMF6ydYhjS31k= ) ); my @also = qw( sig sigin sigex vrfyerrstr ); my $wire = '0002070200000E1052346FD7520CE2D7EDED076E65742D646E73036F7267002119428D83590A475D8E8170E941B10206BF12FC6010D97E2044AEC911FDBE5AF2B32AA77B480FA5C942FBEADA3F7FB2440FA00C81EB324230B0BB9DAA87788AEA00EF7330D4DC444D2EA59B67904C33732D263A767271641A97CA90B739FEDB17752647F18D85C1484E1B95FEA16AF86B3E8344C9E9EC8C17AC9D6218D2DF59'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name $type"); my $nodata = $empty->string; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); } { my @rdata = @data; my $sig = pop @rdata; my $lc = new Net::DNS::RR( lc(". $type @rdata ") . $sig ); my $rr = new Net::DNS::RR( uc(". $type @rdata ") . $sig ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); is( $rr->encode, $lc->encode, 'encoded RDATA names downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type @data"); my $class = ref($rr); $rr->algorithm('RSASHA512'); is( $rr->algorithm(), 10, 'algorithm mnemonic accepted' ); is( $rr->algorithm('MNEMONIC'), 'RSASHA512', "rr->algorithm('MNEMONIC')" ); is( $class->algorithm('RSASHA512'), 10, "class method algorithm('RSASHA512')" ); is( $class->algorithm(10), 'RSASHA512', "class method algorithm(10)" ); is( $class->algorithm(255), 255, "class method algorithm(255)" ); eval { $rr->algorithm('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $object = new Net::DNS::RR( type => $type ); my $class = ref($object); my $scalar = ''; my %testcase = ( ## test callable with invalid arguments '_CreateSig' => [$object, $scalar, $object], '_CreateSigData' => [$object, $scalar], '_string2time' => [undef], '_time2string' => [undef], '_VerifySig' => [$object, $object, $object], 'create' => [$class, $scalar, $object], 'verify' => [$object, $object, $object], ); foreach my $method ( sort keys %testcase ) { my $arglist = $testcase{$method}; $object->{algorithm} = 0; # induce exception no strict q/refs/; my $subroutine = join '::', $class, $method; eval { &$subroutine(@$arglist); }; my $exception = $1 if $@ =~ /^(.*)\n*/; ok( defined $exception, "$method method callable\t[$exception]" ); } } { my %testcase = ( ## test time conversion edge cases -1 => '21060207062815', 0x00000000 => '19700101000000', 0x7fffffff => '20380119031407', 0x80000000 => '20380119031408', 0xf4d41f7f => '21000228235959', 0xf4d41f80 => '21000301000000', 0xffffffff => '21060207062815', ); foreach my $time ( sort keys %testcase ) { my $string = $testcase{$time}; my $result = Net::DNS::RR::RRSIG::_time2string($time); is( $result, $string, "_time2string($time)" ); # Test indirectly: $timeval can be 64-bit or negative 32-bit integer my $timeval = Net::DNS::RR::RRSIG::_string2time($string); my $timestr = Net::DNS::RR::RRSIG::_time2string($timeval); is( $timestr, $string, "_string2time($string)" ); } my $timenow = time(); my $timeval = Net::DNS::RR::RRSIG::_string2time($timenow); is( $timeval, $timenow, "_string2time( time() )\t$timeval" ); } { ok( Net::DNS::RR::RRSIG::_ordered( undef, 0 ), '_ordered( undef, 0 )' ); ok( Net::DNS::RR::RRSIG::_ordered( 0, 1 ), '_ordered( 0, 1 )' ); ok( Net::DNS::RR::RRSIG::_ordered( 0x7fffffff, 0x80000000 ), '_ordered( 0x7fffffff, 0x80000000 )' ); ok( Net::DNS::RR::RRSIG::_ordered( 0xffffffff, 0 ), '_ordered( 0xffffffff, 0 )' ); ok( Net::DNS::RR::RRSIG::_ordered( -2, -1 ), '_ordered( -2, -1 )' ); ok( Net::DNS::RR::RRSIG::_ordered( -1, 0 ), '_ordered( -1, 0 )' ); ok( !Net::DNS::RR::RRSIG::_ordered( undef, undef ), '!_ordered( undef, undef )' ); ok( !Net::DNS::RR::RRSIG::_ordered( 0, undef ), '!_ordered( 0, undef )' ); ok( !Net::DNS::RR::RRSIG::_ordered( 0x80000000, 0x7fffffff ), '!_ordered( 0x80000000, 0x7fffffff )' ); ok( !Net::DNS::RR::RRSIG::_ordered( 0, 0xffffffff ), '!_ordered( 0, 0xffffffff )' ); ok( !Net::DNS::RR::RRSIG::_ordered( -1, -2 ), '!_ordered( -1, -2 )' ); ok( !Net::DNS::RR::RRSIG::_ordered( 0, -1 ), '!_ordered( 0, -1 )' ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/03-question.t0000644000175000017500000002170013031240164014666 0ustar willemwillem# $Id: 03-question.t 1512 2016-10-26 09:14:27Z willem $ -*-perl-*- use strict; use Net::DNS::Question; use Net::DNS::Parameters; use Test::More tests => 119 + keys(%classbyname) + keys(%typebyname); { ## check type conversion functions my ($anon) = 65500; is( typebyval(1), 'A', "typebyval(1)" ); is( typebyval($anon), "TYPE$anon", "typebyval($anon)" ); is( typebyname("TYPE$anon"), $anon, "typebyname('TYPE$anon')" ); is( typebyname("TYPE0$anon"), $anon, "typebyname('TYPE0$anon')" ); my $large = 1 << 16; foreach my $testcase ( "BOGUS", "TYPE$large" ) { eval { typebyname($testcase); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "typebyname($testcase)\t[$exception]" ); } eval { typebyval($large); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "typebyval($large)\t[$exception]" ); foreach ( sort keys %Net::DNS::Parameters::typebyname ) { my $expect = /[*]/ ? 'ANY' : uc($_); my $name = eval { typebyval( typebyname($_) ) }; my $exception = $@ =~ /^(.+)\n/ ? $1 : ''; is( $name, $expect, "typebyname('$_')\t$exception" ); } } { ## check class conversion functions my ($anon) = 65500; is( classbyval(1), 'IN', "classbyval(1)" ); is( classbyval($anon), "CLASS$anon", "classbyval($anon)" ); is( classbyname("CLASS$anon"), $anon, "classbyname('CLASS$anon')" ); is( classbyname("CLASS0$anon"), $anon, "classbyname('CLASS0$anon')" ); my $large = 1 << 16; foreach my $testcase ( "BOGUS", "CLASS$large" ) { eval { classbyname($testcase); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "classbyname($testcase)\t[$exception]" ); } eval { classbyval($large); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "classbyval($large)\t[$exception]" ); foreach ( sort keys %Net::DNS::Parameters::classbyname ) { my $expect = /[*]/ ? 'ANY' : uc($_); my $name = eval { classbyval( classbyname($_) ) }; my $exception = $@ =~ /^(.+)\n/ ? $1 : ''; is( $name, $expect, "classbyname('$_')\t$exception" ); } } { my $name = 'example.com'; my $question = new Net::DNS::Question( $name, 'A', 'IN' ); ok( $question->isa('Net::DNS::Question'), 'object returned by new() constructor' ); is( $question->qname, $name, '$question->qname returns expected value' ); is( $question->qtype, 'A', '$question->qtype returns expected value' ); is( $question->qclass, 'IN', '$question->qclass returns expected value' ); is( $question->name, $question->qname, '$question->name returns expected value' ); is( $question->type, $question->qtype, '$question->type returns expected value' ); is( $question->zname, $question->qname, '$question->zname returns expected value' ); is( $question->ztype, $question->qtype, '$question->ztype returns expected value' ); is( $question->zclass, $question->class, '$question->zclass returns expected value' ); my $string = $question->string; my $expected = "$name.\tIN\tA"; is( $string, $expected, '$question->string returns text representation of object' ); my $test = 'new() argument undefined or absent'; is( new Net::DNS::Question( $name, 'A', undef )->string, $expected, "$test\t( $name,\tA,\tundef\t)" ); is( new Net::DNS::Question( $name, 'A', () )->string, $expected, "$test\t( $name,\tA,\t\t)" ); is( new Net::DNS::Question( $name, undef, 'IN' )->string, $expected, "$test\t( $name,\tundef,\tIN\t)" ); is( new Net::DNS::Question( $name, (), 'IN' )->string, $expected, "$test\t( $name,\t\tIN\t)" ); is( new Net::DNS::Question( $name, undef, undef )->string, $expected, "$test\t( $name,\tundef,\tundef\t)" ); is( new Net::DNS::Question( $name, (), () )->string, $expected, "$test\t( $name \t\t\t)" ); } { my $test = 'new() arguments in zone file order'; my $fqdn = 'example.com.'; foreach my $class (qw(IN CLASS1 ANY)) { foreach my $type (qw(A TYPE1 ANY)) { my $testcase = new Net::DNS::Question( $fqdn, $class, $type )->string; my $expected = new Net::DNS::Question( $fqdn, $type, $class )->string; is( $testcase, $expected, "$test\t( $fqdn,\t$class,\t$type\t)" ); } } } { my $question = eval { new Net::DNS::Question(undef); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "argument undefined\t[$exception]" ); } { foreach my $method (qw(qname qtype qclass name)) { my $question = eval { new Net::DNS::Question('.')->$method('name'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "$method read-only:\t[$exception]" ); } } { my $wiredata = pack 'H*', '000001'; my $question = eval { decode Net::DNS::Question( \$wiredata ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "corrupt wire-format\t[$exception]" ); } { my $test = 'decoded object matches encoded data'; foreach my $class (qw(IN HS ANY)) { foreach my $type (qw(A AAAA MX NS SOA ANY)) { my $question = new Net::DNS::Question( 'example.com', $type, $class ); my $encoded = $question->encode; my $expected = $question->string; my $decoded = decode Net::DNS::Question( \$encoded ); is( $decoded->string, $expected, "$test\t$expected" ); } } } { my $question = new Net::DNS::Question('example.com'); my $encoded = $question->encode; my ( $decoded, $offset ) = decode Net::DNS::Question( \$encoded ); is( $offset, length($encoded), 'returned offset has expected value' ); } { my @part = ( 1 .. 4 ); while (@part) { my $test = 'interpret IPv4 prefix as PTR query'; my $prefix = join '.', @part; my $domain = new Net::DNS::Question($prefix); my $actual = $domain->qname; my $invert = join '.', reverse 'in-addr.arpa', @part; my $inaddr = new Net::DNS::Question($invert); my $expect = $inaddr->qname; is( $actual, $expect, "$test\t$prefix" ); pop @part; } } { foreach my $type (qw(NS SOA ANY)) { my $test = "query $type in in-addr.arpa namespace"; my $question = new Net::DNS::Question( '1.2.3.4', $type ); my $qtype = $question->qtype; my $string = $question->string; is( $qtype, $type, "$test\t$string" ); } } { foreach my $n ( 32, 24, 16, 8 ) { my $ip4 = '1.2.3.4'; my $test = "accept CIDR address/$n prefix syntax"; my $m = ( ( $n + 7 ) >> 3 ) << 3; my $actual = new Net::DNS::Question("$ip4/$n"); my $expect = new Net::DNS::Question("$ip4/$m"); my $string = $expect->qname; is( $actual->qname, $expect->qname, "$test\t$string" ); } } { is( new Net::DNS::Question('1:2:3:4:5:6:7:8')->string, "8.0.0.0.7.0.0.0.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR", 'interpret IPv6 address as PTR query in ip6.arpa namespace' ); is( new Net::DNS::Question('::ffff:1.2.3.4')->string, "4.3.2.1.in-addr.arpa.\tIN\tPTR", 'interpret IPv6 form of IPv4 address as query in in-addr.arpa' ); is( new Net::DNS::Question('1:2:3:4:5:6:254.235.218.237')->string, "d.e.a.d.b.e.e.f.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR", 'interpret IPv6 + embedded IPv4 address as query in ip6.arpa' ); is( new Net::DNS::Question(':x:')->string, ":x:.\tIN\tA", 'non-address character precludes interpretation as PTR query' ); is( new Net::DNS::Question(':.:')->string, ":.:.\tIN\tA", 'non-numeric character precludes interpretation as PTR query' ); } { my @part = ( 1 .. 8 ); while (@part) { my $n = 16 * scalar(@part); my $test = 'interpret IPv6 prefix as PTR query'; my $prefix = join ':', @part; my $actual = new Net::DNS::Question($prefix)->qname; my $expect = new Net::DNS::Question("$prefix/$n")->qname; is( $actual, $expect, "$test\t$prefix" ) if $prefix =~ /:/; pop @part; } } { foreach my $n ( 16, 12, 8, 4 ) { my $ip6 = '1234:5678:9012:3456:7890:1234:5678:9012'; my $test = "accept IPv6 address/$n prefix syntax"; my $m = ( ( $n + 3 ) >> 2 ) << 2; my $actual = new Net::DNS::Question("$ip6/$n"); my $expect = new Net::DNS::Question("$ip6/$m"); my $string = $expect->qname; is( $actual->qname, $expect->qname, "$test\t$string" ); } } { my $expected = length new Net::DNS::Question('1:2:3:4:5:6:7:8')->qname; foreach my $i ( reverse 0 .. 6 ) { foreach my $j ( $i + 3 .. 9 ) { my $ip6 = join( ':', 1 .. $i ) . '::' . join( ':', $j .. 8 ); my $name = new Net::DNS::Question("$ip6")->qname; is( length $name, $expected, "check length of expanded IPv6 address\t$ip6" ); } } } eval { ## exercise but do not test print my $object = new Net::DNS::Question('example.com'); my $filename = '03-question.txt'; open( TEMP, ">$filename" ) || die "Could not open $filename for writing"; select( ( select(TEMP), $object->print )[0] ); close(TEMP); unlink($filename); }; ## exercise but do not test ad hoc RRtype registration Net::DNS::Parameters::register( 'TOY', 65280 ); # RR type name and number Net::DNS::Parameters::register( 'TOY', 65280 ); # ignore duplicate entry eval { Net::DNS::Parameters::register('ANY') }; # reject CLASS identifier eval { Net::DNS::Parameters::register('A') }; # reject conflicting type name eval { Net::DNS::Parameters::register( 'Z', 1 ) }; # reject conflicting type number exit; Net-DNS-1.07/t/07-rrsort.t0000644000175000017500000000741313031240164014363 0ustar willemwillem# $Id: 07-rrsort.t 1381 2015-08-25 07:36:09Z willem $ -*-perl-*- use Test::More; use strict; use Net::DNS qw(rrsort); plan tests => 22; my $rr1=Net::DNS::RR->new("example.com. 600 IN SRV 0 0 5060 A.example.com."); is(ref($rr1),"Net::DNS::RR::SRV","SRV RR1 created"); my $rr2=Net::DNS::RR->new("example.com. 600 IN SRV 1 0 5060 A.example.com."); is(ref($rr2),"Net::DNS::RR::SRV","SRV RR2 created"); my $rr3=Net::DNS::RR->new("example.com. 600 IN SRV 2 0 5060 A.example.com."); is(ref($rr3),"Net::DNS::RR::SRV","SRV RR3 created"); my $rr4=Net::DNS::RR->new("example.com. 600 IN SRV 3 0 5060 A.example.com."); is(ref($rr4),"Net::DNS::RR::SRV","SRV RR4 created"); my $rr5=Net::DNS::RR->new("example.com. 600 IN SRV 3 1 5060 A.example.com."); is(ref($rr5),"Net::DNS::RR::SRV","SRV RR5 created"); my $rr6=Net::DNS::RR->new("example.com. 600 IN SRV 3 2 5060 A.example.com."); is(ref($rr6),"Net::DNS::RR::SRV","SRV RR6 created"); my $rr7=Net::DNS::RR->new("example.com. 600 IN SRV 1 3 5070 A.example.com."); is(ref($rr7),"Net::DNS::RR::SRV","SRV RR7 created"); my $rr8=Net::DNS::RR->new("example.com. 600 IN SRV 3 3 5070 A.example.com."); is(ref($rr8),"Net::DNS::RR::SRV","SRV RR8 created"); my $rr9=Net::DNS::RR->new("example.com. 600 IN A 192.168.0.1"); is(ref($rr9),"Net::DNS::RR::A","A RR9 created"); my @rrarray=($rr1, $rr2, $rr3, $rr4, $rr5, $rr6, $rr7, $rr8, $rr9); my @expectedrdata=($rr1, $rr2, $rr3, $rr7, $rr4, $rr5, $rr6, $rr8); my @expectedpriority=($rr1, $rr7, $rr2, $rr3, $rr8, $rr6, $rr5, $rr4); is (scalar rrsort("SRV"),0,"rrsort returns properly with undefined arguments"); is (scalar rrsort("SRV",@rrarray),8,"rrsort returns properly with undefined attribute (1)"); is (scalar rrsort("SRV",,@rrarray),8,"rrsort returns properly with undefined attribute (2)"); is (scalar rrsort("SRV","",@rrarray),8,"rrsort returns properly with undefined attribute (3)"); my @prioritysorted= rrsort("SRV","priority",@rrarray); my @defaultsorted= rrsort("SRV",@rrarray); my @portsorted= rrsort("SRV","port",@rrarray); my @foosorted= rrsort("SRV","foo",@rrarray); is (scalar @foosorted,8,"rrsort returns properly with undefined attribute (4)"); is (scalar @prioritysorted,8,"rrsort correctly maintains RRs test 1"); is (scalar @portsorted,8,"rrsort correctly maintains RRs test 2"); is (scalar rrsort("A","priority",@rrarray),1,"rrsort correctly maintains RRs test 3"); is (scalar rrsort("MX","priority",@rrarray),0,"rrsort correctly maintains RRs test 4"); ok (eq_array(\@expectedpriority, \@prioritysorted), "Sorting on SRV priority works"); ok (eq_array(\@expectedpriority, \@defaultsorted), "Default SRV sort works"); # # Test with MX RRs. # my $mxrr1=Net::DNS::RR->new("example.com. 600 IN MX 10 mx1.example.com"); my $mxrr2=Net::DNS::RR->new("example.com. 600 IN MX 6 mx2.example.com"); my $mxrr3=Net::DNS::RR->new("example.com. 600 IN MX 66 mx3.example.com"); my $mxrr4=Net::DNS::RR->new("example.com. 600 IN RT 6 rt1.example.com"); my @mxrrarray=($mxrr1, $mxrr2, $mxrr3, $mxrr4); my @expectedmxarray=($mxrr2,$mxrr1,$mxrr3); my @sortedmxarray=rrsort("MX",@mxrrarray); ok (eq_array(\@expectedmxarray,\@sortedmxarray),"MX sorting"); my $nsrr1=Net::DNS::RR->new("example.com. 600 IN NS ns2.example.com"); my $nsrr2=Net::DNS::RR->new("example.com. 600 IN NS ns4.example.com"); my $nsrr3=Net::DNS::RR->new("example.com. 600 IN NS ns1.example.com"); my $nsrr4=Net::DNS::RR->new("example.com. 600 IN RT 6 rt1.example.com"); my @nsrrarray=($nsrr1, $nsrr2, $nsrr3, $nsrr4); my @expectednsarray=($nsrr3,$nsrr1,$nsrr2); my @sortednsarray=rrsort("NS",@nsrrarray); ok (eq_array(\@expectednsarray,\@sortednsarray),"NS sorting"); Net-DNS-1.07/t/05-DNSKEY.t0000644000175000017500000000554113031240164014023 0ustar willemwillem# $Id: 05-DNSKEY.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 29; my $name = 'DNSKEY.example'; my $type = 'DNSKEY'; my $code = 48; my @attr = qw( flags protocol algorithm key ); my @data = ( 256, 3, 5, join '', qw( AQPSKmynfzW4kyBv015MUG2DeIQ3 Cbl+BBZH4b/0PY1kxkmvHjcZc8no kfzj31GajIQKY+5CptLr3buXA10h WqTkF7H6RfoRqXQeogmMHfpftf6z Mv1LyBUgia7za6ZEzOJBOztyvhjL 742iU/TpPSEDhm2SNKLijfUppn1U aNvv4w== ) ); my @also = qw( keybin keylength keytag privatekeyname zone revoke sep ); my $wire = join '', qw( 010003050103D22A6CA77F35B893206FD35E4C506D8378843709B97E041647E1 BFF43D8D64C649AF1E371973C9E891FCE3DF519A8C840A63EE42A6D2EBDDBB97 035D215AA4E417B1FA45FA11A9741EA2098C1DFA5FB5FEB332FD4BC8152089AE F36BA644CCE2413B3B72BE18CBEF8DA253F4E93D2103866D9234A2E28DF529A6 7D5468DBEFE3 ); { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name NULL"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); } { my $rr = new Net::DNS::RR(". $type @data"); my $class = ref($rr); $rr->algorithm('RSASHA512'); is( $rr->algorithm(), 10, 'algorithm mnemonic accepted' ); is( $rr->algorithm('MNEMONIC'), 'RSASHA512', "rr->algorithm('MNEMONIC')" ); is( $class->algorithm('RSASHA512'), 10, "class method algorithm('RSASHA512')" ); is( $class->algorithm(10), 'RSASHA512', "class method algorithm(10)" ); is( $class->algorithm(255), 255, "class method algorithm(255)" ); eval { $rr->algorithm('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach ( @attr, qw(keylength keytag rdstring) ) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-RP.t0000644000175000017500000000453113031240164013345 0ustar willemwillem# $Id: 05-RP.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 15; use Net::DNS; my $name = 'RP.example'; my $type = 'RP'; my $code = 17; my @attr = qw( mbox txtdname ); my @data = qw( rp@example.com txt.example.net ); my @also = qw( ); my $wire = '027270076578616d706c6503636f6d0003747874076578616d706c65036e657400'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/01-resolver-file.t0000644000175000017500000000167513031240164015604 0ustar willemwillem# $Id: 01-resolver-file.t 1406 2015-10-05 08:25:49Z willem $ use strict; use Test::More; BEGIN { chdir 't/' || die "Couldn't chdir to t/\n"; # t/.resolv.conf unshift( @INC, '../blib/lib', '../blib/arch' ); } use Net::DNS; my $res = Net::DNS::Resolver->new; plan skip_all => 'File parsing only supported on Unix' unless $res->isa('Net::DNS::Resolver::UNIX'); plan skip_all => 'Could not read configuration file' unless -r '.resolv.conf' && -o _; plan tests => 7; ok( $res->isa('Net::DNS::Resolver'), 'new() created object' ); my @servers = $res->nameservers; ok( scalar(@servers), "nameservers() works" ); is( $servers[0], '10.0.1.128', 'nameservers list correct' ); is( $servers[1], '10.0.2.128', 'nameservers list correct' ); my @search = $res->searchlist; is( $search[0], 'net-dns.org', 'searchlist correct' ); is( $search[1], 'lib.net-dns.org', 'searchlist correct' ); is( $res->domain, 'net-dns.org', 'domain correct' ); exit; Net-DNS-1.07/t/36-NSEC3-covered.t0000644000175000017500000000464313031240164015274 0ustar willemwillem# $Id: 36-NSEC3-covered.t 1389 2015-09-09 13:09:43Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Digest::SHA Net::DNS::RR::NSEC3; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 14; ## IMPORTANT: Do not modify names or hash parameters in any way. ## These are crafted to provide known hash relationships. my $algorithm = 1; my $flags = 0; my $iteration = 12; my $salt = 'aabbccdd'; my $saltbin = pack 'H*', $salt; my @param = ( $algorithm, $flags, $iteration, $salt ); my @name = qw( domain.parent.example d.domain.parent.example n.domain.parent.example p.domain.parent.example q.domain.parent.example *.domain.parent.example ); my %hash; foreach my $name (@name) { $hash{$name} = Net::DNS::RR::NSEC3::name2hash( $algorithm, $name, $iteration, $saltbin ); } my %name = reverse %hash; foreach ( sort keys %name ) { print join "\t", $_, $name{$_}, "\n"; } my $hzone = $hash{'domain.parent.example'}; my $cover = $hash{'n.domain.parent.example'}; my $hnext = $hash{'d.domain.parent.example'}; my $bfore = $hash{'p.domain.parent.example'}; my $after = $hash{'q.domain.parent.example'}; my $nsec3 = new Net::DNS::RR("$hzone.$name{$hzone}. NSEC3 @param $hnext"); foreach my $name ( $name{$hzone} ) { ok( !$nsec3->covered($name), "NSEC3 owner name not covered\t($name)" ); } foreach my $name ( $name{$cover} ) { ok( $nsec3->covered($name), "NSEC3 covers enclosed name\t($name)" ); } foreach my $name ( $name{$hnext} ) { ok( !$nsec3->covered($name), "NSEC3 next name not covered\t($name)" ); } foreach my $name ( $name{$bfore}, $name{$after} ) { ok( !$nsec3->covered($name), "NSEC3 does not cover other name\t($name)" ); } my $last = new Net::DNS::RR("$hnext.$name{$hzone}. NSEC3 @param $hzone"); foreach my $name ( $name{$hnext} ) { ok( !$last->covered($name), "last NSEC3 owner not covered\t($name)" ); } foreach my $name ( $name{$hzone} ) { ok( !$last->covered($name), "last NSEC3 next not covered\t($name)" ); } foreach my $name ( $name{$bfore}, $name{$after} ) { ok( $last->covered($name), "last NSEC3 covers other name\t($name)" ); } my @domain = qw( sibling.parent.example parent.example uncle.example cousin.uncle.example domain.unrelated ); foreach my $name (@domain) { ok( !$nsec3->covered($name), "other domain not covered\t($name)" ); } exit; Net-DNS-1.07/t/05-NSEC3PARAM.t0000644000175000017500000000466413031240164014427 0ustar willemwillem# $Id: 05-NSEC3PARAM.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 22; use Net::DNS; my $name = 'example'; my $type = 'NSEC3PARAM'; my $code = 51; my @attr = qw( algorithm flags iterations salt ); my @data = qw( 1 1 12 aabbccdd ); my @also = qw( hashalgo ); my $wire = '0101000c04aabbccdd'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { # check parsing of RR with null salt (RT#95034) my $string = 'nosalt.example. IN NSEC3PARAM 2 0 12 -'; my $rr = eval { Net::DNS::RR->new($string) }; diag $@ if $@; ok( $rr, 'NSEC3PARAM created with null salt' ); is( $rr->salt, '', 'NSEC3PARAM null salt value' ); is( unpack( 'H*', $rr->saltbin ), '', 'NSEC3PARAM null salt binary value' ); is( $rr->string, $string, 'NSEC3PARAM null salt binary value' ); } { my $rr = eval { Net::DNS::RR->new('corrupt.example NSEC3PARAM 2 0 12 aabbccfs') }; ok( !$rr, 'NSEC3PARAM not created with corrupt hex data' ); } exit; Net-DNS-1.07/t/37-NSEC3-base32.t0000644000175000017500000000170713031240164014723 0ustar willemwillem# $Id: 37-NSEC3-base32.t 1389 2015-09-09 13:09:43Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( Net::DNS::RR::NSEC3; ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 20; my %testcase = ( "U" => 'ak', "UU" => 'alag', "UUU" => 'alala', "UUUU" => 'alalal8', "UUUUU" => 'alalalal', "UUUUUU" => 'alalalalak', "UUUUUUU" => 'alalalalalag', "UUUUUUUU" => 'alalalalalala', "UUUUUUUUU" => 'alalalalalalal8', "UUUUUUUUUU" => 'alalalalalalalal', ); foreach my $binary ( sort keys %testcase ) { my $expect = $testcase{$binary}; my $encode = Net::DNS::RR::NSEC3::_encode_base32($binary); my $decode = Net::DNS::RR::NSEC3::_decode_base32($encode); is( $encode, $expect, 'base32 encode correct' ); is( length($decode), length($binary), 'decode length correct' ); } exit; Net-DNS-1.07/t/05-DHCID.t0000644000175000017500000000433213031240164013636 0ustar willemwillem# $Id: 05-DHCID.t 1390 2015-09-11 11:42:11Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 15; my $name = 'DHCID.example'; my $type = 'DHCID'; my $code = 49; my @attr = qw( identifiertype digesttype digest ); my @data = qw( 2 1 ObfuscatedIdentityData ); my @also = qw( rdata ); my $wire = '0002014f6266757363617465644964656e7469747944617461'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); $rr->print; } exit; Net-DNS-1.07/t/05-DNAME.t0000644000175000017500000000444613031240164013655 0ustar willemwillem# $Id: 05-DNAME.t 1362 2015-06-23 08:47:14Z willem $ -*-perl-*- use strict; use Test::More tests => 14; use Net::DNS; my $name = 'DNAME.example'; my $type = 'DNAME'; my $code = 39; my @attr = qw( target ); my @data = qw( example.com ); my @also = qw( dname ); my $wire = '076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-OPT.t0000644000175000017500000000672113031240164013471 0ustar willemwillem# $Id: 05-OPT.t 1367 2015-06-29 08:53:56Z willem $ -*-perl-*- use strict; use Test::More; use Net::DNS; use Net::DNS::Parameters; my @opt = keys %Net::DNS::Parameters::ednsoptionbyname; plan tests => 29 + scalar(@opt); my $name = '.'; my $type = 'OPT'; my $code = 41; my @attr = qw( size rcode flags ); my @data = qw( 1280 0 32768 ); my @also = qw( version ); my $wire = '0000290500000080000000'; { ## check conversion functions foreach ( sort( keys %Net::DNS::Parameters::ednsoptionbyname ), 65500 ) { my $expect = uc($_); my $name = eval { my $val = ednsoptionbyname($_); ednsoptionbyval( ednsoptionbyname($val) ); }; my $exception = $@ =~ /^(.+)\n/ ? $1 : ''; is( $name, $expect, "ednsoptionbyname('$_')\t$exception" ); } foreach my $testcase ('BOGUS') { eval { ednsoptionbyname($testcase); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "ednsoptionbyname($testcase)\t[$exception]" ); } } { my $typecode = unpack 'xn', new Net::DNS::RR( name => '.', type => $type )->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; like( $string, '/EDNS/', 'string method works' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { my $value = $rr->$_; ok( defined $rr->$_, "additional attribute rr->$_()" ); } my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $encoded; my $hex2 = uc unpack 'H*', $decoded->encode; is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex1, $wire, 'encoded RDATA matches example' ); } { my $rr = new Net::DNS::RR( name => '.', type => $type ); foreach (@attr) { my $initial = 0x5A5; my $changed = 0xA5A; $rr->{$_} = $initial; is( $rr->$_($changed), $changed, "rr->$_(x) returns function argument" ); is( $rr->$_(), $changed, "rr->$_(x) changes attribute value" ); } } foreach my $method (qw(class ttl)) { my $rr = new Net::DNS::RR( name => '.', type => $type ); eval { local $SIG{__WARN__} = sub { die @_ }; $rr->$method(1); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "$method method:\t[$exception]" ); eval { local $SIG{__WARN__} = sub { die @_ }; $rr->$method(0); }; my $repeated = $1 if $@ =~ /^(.+)\n/; ok( !$repeated, "$method exception not repeated $@" ); } { my $rr = new Net::DNS::RR( name => '.', type => $type, rcode => 16 ); $rr->{rdlength} = 0; # inbound OPT RR only like( $rr->string, '/BADVER/', 'opt->rcode(16)' ); } { my $rr = new Net::DNS::RR( name => '.', type => $type, rcode => 1 ); like( $rr->string, '/NOERROR/', 'opt->rcode(1)' ); } { my $rr = new Net::DNS::RR( name => '.', type => $type ); $rr->option( 99 => '' ); is( scalar( $rr->options ), 1, 'insert EDNS option' ); $rr->option( 99 => undef ); is( scalar( $rr->options ), 0, 'delete EDNS option' ); my $n = 3; $n++ until ednsoptionbyval($n) eq "$n"; my @optn = ( ( $n - 3 ) .. $n ); foreach (@optn) { my $value = "value $_"; $rr->option( $_ => $value ); } my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my @result = sort $decoded->options; is( scalar(@result), scalar(@optn), 'expected number of options' ); foreach (@result) { my $value = "value $_"; is( $decoded->option($_), $value, "expected value for option $_" ); } $rr->print; } exit; Net-DNS-1.07/t/00-version.t0000644000175000017500000000312113031240164014476 0ustar willemwillem# $Id: 00-version.t 1518 2016-11-21 14:24:22Z willem $ -*-perl-*- use strict; use Test::More; use File::Spec; use File::Find; use ExtUtils::MakeMaker; my @files; my $blib = File::Spec->catfile(qw(blib lib)); find( sub { push( @files, $File::Find::name ) if /\.pm$/ && !/Template/ }, $blib ); my %manifest; open MANIFEST, 'MANIFEST' or plan skip_all => "MANIFEST: $!"; while () { chomp; my ( $volume, $directory, $name ) = File::Spec->splitpath($_); $manifest{lc $name}++ if $name; } close MANIFEST; plan skip_all => 'No versions from git checkouts' if -e '.git'; plan skip_all => 'Not sure how to parse versions.' unless eval { MM->can('parse_version') }; plan tests => scalar @files; foreach my $file ( sort @files ) { my $version = MM->parse_version($file); diag("$file\t=>\t$version") if $ENV{'NET_DNS_DEBUG'}; ok( $version =~ /[\d.]{3}/, "file version: $version\t$file" ); my ( $volume, $directory, $name ) = File::Spec->splitpath($file); diag("File not in MANIFEST: $file") unless $manifest{lc $name}; } END { eval 'local @INC = grep $_ !~ m/blib/i, @INC; require Net::DNS'; my @installed = grep $_ =~ m/\WNet\WDNS.pm$/i, values %INC; warn < 13; use Net::DNS; my $name = '1.2.0.192.in-addr.arpa'; my $type = 'PTR'; my $code = 12; my @attr = qw( ptrdname ); my @data = qw( example.com ); my @also = qw( ); my $wire = '076578616d706c6503636f6d00'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } { my $lc = new Net::DNS::RR( lc ". $type @data" ); my $rr = new Net::DNS::RR( uc ". $type @data" ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed < length $predecessor, 'encoded RDATA compressible' ); isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } exit; Net-DNS-1.07/t/05-SIG.t0000644000175000017500000001440313031240164013445 0ustar willemwillem# $Id: 05-SIG.t 1406 2015-10-05 08:25:49Z willem $ -*-perl-*- # use strict; use Test::More; use Net::DNS; my @prerequisite = qw( MIME::Base64 Time::Local ); foreach my $package (@prerequisite) { next if eval "require $package"; plan skip_all => "$package not installed"; exit; } plan tests => 72; my $name = '.'; my $type = 'SIG'; my $code = 24; my @attr = qw( typecovered algorithm labels orgttl sigexpiration siginception keytag signame signature ); my @data = ( qw( TYPE0 1 0 0 20150814181655 20150814181155 2871 rsamd5.example ), join '', qw( GOjsIo2JXz2ASClRhdbD5W+IYkq+Eo5iF9l3R+LYS/14Q fxqX2M9YHPvuLfz5ORAdnqyuKJTi3/LsrHmF/cUzwY3UM ZJDeGce77WiUJlR93VRKZ4fTs/wPP7JHxgAIhhlYFB4xs vISZr/tgvblxwJSpa4pJIahUuitfaiijFwQw= ) ); my @also = qw( sig sigex sigin vrfyerrstr _size ); my $wire = '000001000000000055CE309755CE2F6B0B37067273616D6435076578616D706C650018E8EC228D895F3D8048295185D6C3E56F88624ABE128E6217D97747E2D84BFD7841FC6A5F633D6073EFB8B7F3E4E440767AB2B8A2538B7FCBB2B1E617F714CF063750C6490DE19C7BBED689426547DDD544A6787D3B3FC0F3FB247C60008861958141E31B2F21266BFED82F6E5C70252A5AE292486A152E8AD7DA8A28C5C10C'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } my $empty = new Net::DNS::RR("$name $type"); my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = uc unpack 'H*', $decoded->encode; my $hex2 = uc unpack 'H*', $encoded; my $hex3 = uc unpack 'H*', substr( $encoded, length $empty->encode ); is( $hex1, $hex2, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); my @wire = unpack 'C*', $encoded; my $wireformat = pack 'C*', @wire, 0; eval { decode Net::DNS::RR( \$wireformat ); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "misplaced SIG RR\t[$exception]" ); } { my @rdata = @data; my $sig = pop @rdata; my $lc = new Net::DNS::RR( lc(". $type @rdata ") . $sig ); my $rr = new Net::DNS::RR( uc(". $type @rdata ") . $sig ); my $hash = {}; my $predecessor = $rr->encode( 0, $hash ); my $compressed = $rr->encode( length $predecessor, $hash ); ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' ); is( $rr->encode, $lc->encode, 'encoded RDATA names downcased' ); is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' ); } { my $rr = new Net::DNS::RR(". $type @data"); my $class = ref($rr); $rr->algorithm('RSASHA1'); is( $rr->algorithm(), 5, 'algorithm mnemonic accepted' ); is( $rr->algorithm('MNEMONIC'), 'RSASHA1', "rr->algorithm('MNEMONIC')" ); is( $class->algorithm('RSASHA1'), 5, "class method algorithm('RSASHA1')" ); is( $class->algorithm(5), 'RSASHA1', "class method algorithm(5)" ); is( $class->algorithm(255), 255, "class method algorithm(255)" ); eval { $rr->algorithm('X'); }; my $exception = $1 if $@ =~ /^(.+)\n/; ok( $exception ||= '', "unknown mnemonic\t[$exception]" ); } { my $rr = new Net::DNS::RR(". $type"); foreach (@attr) { ok( !$rr->$_(), "'$_' attribute of empty RR undefined" ); } } { my $object = new Net::DNS::RR(". $type"); my $class = ref($object); my $scalar = ''; my %testcase = ( ## test callable with invalid arguments '_CreateSig' => [$object, $scalar, $object], '_CreateSigData' => [$object, $object], '_string2time' => [undef], '_time2string' => [undef], '_VerifySig' => [$object, $object, $object], 'create' => [$class, $scalar, $object], 'verify' => [$object, $object, $object], ); foreach my $method ( sort keys %testcase ) { my $arglist = $testcase{$method}; $object->{algorithm} = 0; # induce exception no strict q/refs/; my $subroutine = join '::', $class, $method; eval { &$subroutine(@$arglist); }; my $exception = $1 if $@ =~ /^(.*)\n*/; ok( defined $exception, "$method method callable\t[$exception]" ); } } { my %testcase = ( ## test time conversion edge cases -1 => '21060207062815', 0x00000000 => '19700101000000', 0x7fffffff => '20380119031407', 0x80000000 => '20380119031408', 0xf4d41f7f => '21000228235959', 0xf4d41f80 => '21000301000000', 0xffffffff => '21060207062815', ); foreach my $time ( sort keys %testcase ) { my $string = $testcase{$time}; my $result = Net::DNS::RR::SIG::_time2string($time); is( $result, $string, "_time2string($time)" ); # Test indirectly: $timeval can be 64-bit or negative 32-bit integer my $timeval = Net::DNS::RR::SIG::_string2time($string); my $timestr = Net::DNS::RR::SIG::_time2string($timeval); is( $timestr, $string, "_string2time($string)" ); } my $timenow = time(); my $timeval = Net::DNS::RR::SIG::_string2time($timenow); is( $timeval, $timenow, "_string2time( time() )\t$timeval" ); } { ok( Net::DNS::RR::SIG::_ordered( undef, 0 ), '_ordered( undef, 0 )' ); ok( Net::DNS::RR::SIG::_ordered( 0, 1 ), '_ordered( 0, 1 )' ); ok( Net::DNS::RR::SIG::_ordered( 0x7fffffff, 0x80000000 ), '_ordered( 0x7fffffff, 0x80000000 )' ); ok( Net::DNS::RR::SIG::_ordered( 0xffffffff, 0 ), '_ordered( 0xffffffff, 0 )' ); ok( Net::DNS::RR::SIG::_ordered( -2, -1 ), '_ordered( -2, -1 )' ); ok( Net::DNS::RR::SIG::_ordered( -1, 0 ), '_ordered( -1, 0 )' ); ok( !Net::DNS::RR::SIG::_ordered( undef, undef ), '!_ordered( undef, undef )' ); ok( !Net::DNS::RR::SIG::_ordered( 0, undef ), '!_ordered( 0, undef )' ); ok( !Net::DNS::RR::SIG::_ordered( 0x80000000, 0x7fffffff ), '!_ordered( 0x80000000, 0x7fffffff )' ); ok( !Net::DNS::RR::SIG::_ordered( 0, 0xffffffff ), '!_ordered( 0, 0xffffffff )' ); ok( !Net::DNS::RR::SIG::_ordered( -1, -2 ), '!_ordered( -1, -2 )' ); ok( !Net::DNS::RR::SIG::_ordered( 0, -1 ), '!_ordered( 0, -1 )' ); } { my $rr = new Net::DNS::RR("$name $type @data"); $rr->print; } exit; Net-DNS-1.07/t/05-NULL.t0000644000175000017500000000344413031240164013600 0ustar willemwillem# $Id: 05-NULL.t 1340 2015-04-28 11:39:55Z willem $ -*-perl-*- use strict; use Test::More tests => 10; use Net::DNS; my $name = 'NULL.example'; my $type = 'NULL'; my $code = 10; my @attr = qw( ); my @data = ('\# 4 61626364'); my @also = qw( rdlength rdata ); my $wire = '61626364'; { my $typecode = unpack 'xn', new Net::DNS::RR(". $type")->encode; is( $typecode, $code, "$type RR type code = $code" ); my $hash = {}; @{$hash}{@attr} = @data; my $rr = new Net::DNS::RR( name => $name, type => $type, rdata => 'arbitrary data', %$hash ); my $string = $rr->string; my $rr2 = new Net::DNS::RR($string); is( $rr2->string, $string, 'new/string transparent' ); is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); foreach (@attr) { is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); } foreach (@also) { is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } } { my $rr = new Net::DNS::RR("$name $type @data"); my $null = new Net::DNS::RR("$name NULL")->encode; my $empty = new Net::DNS::RR("$name $type")->encode; my $rxbin = decode Net::DNS::RR( \$empty )->encode; my $txtext = new Net::DNS::RR("$name $type")->string; my $rxtext = new Net::DNS::RR($txtext)->encode; my $encoded = $rr->encode; my $decoded = decode Net::DNS::RR( \$encoded ); my $hex1 = unpack 'H*', $encoded; my $hex2 = unpack 'H*', $decoded->encode; my $hex3 = unpack 'H*', substr( $encoded, length $null ); is( $hex2, $hex1, 'encode/decode transparent' ); is( $hex3, $wire, 'encoded RDATA matches example' ); is( length($empty), length($null), 'encoded RDATA can be empty' ); is( length($rxbin), length($null), 'decoded RDATA can be empty' ); is( length($rxtext), length($null), 'string RDATA can be empty' ); } exit; Net-DNS-1.07/t/06-packet-unique-push.t0000644000175000017500000000562213031240164016557 0ustar willemwillem# $Id: 06-packet-unique-push.t 1367 2015-06-29 08:53:56Z willem $ use strict; BEGIN { use Test::More tests => 45; use_ok('Net::DNS'); } # Matching of RR name is not case sensitive my $domain = 'example.com'; my $method = 'unique_push'; my $packet = Net::DNS::Packet->new($domain); my $rr_1 = Net::DNS::RR->new('bla.FOO 100 IN TXT "lower case"'); my $rr_2 = Net::DNS::RR->new('bla.foo 100 IN TXT "lower case"'); my $rr_3 = Net::DNS::RR->new('bla.foo 100 IN TXT "mixed CASE"'); my $rr_4 = Net::DNS::RR->new('bla.foo 100 IN TXT "MIXED case"'); $packet->unique_push( "answer", $rr_1 ); $packet->unique_push( "answer", $rr_2 ); is( $packet->header->ancount, 1, "unique_push case sensitivity test 1" ); $packet->unique_push( "answer", $rr_3 ); $packet->unique_push( "answer", $rr_4 ); is( $packet->header->ancount, 3, "unique_push case sensitivity test 2" ); my %sections = ( answer => 'ancount', authority => 'nscount', additional => 'arcount', ); my @tests = ( [ 1, Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), ], [ 2, Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('bar.example.com 60 IN A 192.0.2.1'), ], [ 1, Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('foo.example.com 90 IN A 192.0.2.1'), ], [ 3, Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.3'), ], [ 3, Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.3'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), ], [ 3, Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'), Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.4'), Net::DNS::RR->new('foo.example.com 60 HS A 192.0.2.4'), ], [ 3, Net::DNS::RR->new('foo.example.com IN A'), Net::DNS::RR->new('foo.example.com ANY A'), Net::DNS::RR->new('foo.example.com NONE A'), ], ); foreach my $test (@tests) { my ( $expect, @rrs ) = @$test; while ( my ( $section, $count_meth ) = each %sections ) { my $packet = new Net::DNS::Update($domain); $packet->$method( $section => @rrs ); my $count = $packet->header->$count_meth(); is( $count, $expect, "$method $section => RR, RR, ..." ); } # # Now do it again, pushing each RR individually. # while ( my ( $section, $count_meth ) = each %sections ) { my $packet = new Net::DNS::Update($domain); foreach my $rr (@rrs) { $packet->$method( $section => $rr ); } my $count = $packet->header->$count_meth(); is( $count, $expect, "$method $section => RR" ); } } Net-DNS-1.07/demo/0000755000175000017500000000000013031240175013075 5ustar willemwillemNet-DNS-1.07/demo/README0000644000175000017500000000166713031240164013765 0ustar willemwillemThis directory contains demonstration scripts for the Net::DNS module. To read the manual page for a particular program, run the command "perldoc program-name". axfr Performs a zone transfer and stores the zone in a file. If a zone file already exists, axfr reads the file instead of performing a zone transfer. Requires the Storable module (available on CPAN). check_soa Perl version of the check_soa program presented in _DNS and BIND_ by Paul Albitz & Cricket Liu. Also see the check_soa version in the Contrib directory which is an fires off the queries in parallel. check_zone Checks a zone for errors like missing PTR records. Can recurse into subdomains. See also a hacked version in contrib/check_zone. mresolv Performs multiple DNS queries in parallel. mx Prints a domain's MX records sorted by preference. perldig Performs DNS queries and print the results. --- $Id: README 607 2006-09-17 18:20:28Z olaf $ Net-DNS-1.07/demo/perldig0000755000175000017500000000235713031240164014456 0ustar willemwillem#!/usr/local/bin/perl -w # $Id: perldig 264 2005-04-06 09:16:15Z olaf $ =head1 NAME perldig - Perl script to perform DNS queries =head1 SYNOPSIS C [ C<@>I ] I [ I [ I ] ] =head1 DESCRIPTION Performs a DNS query on the given name. The record type and class can also be specified; if left blank they default to A and IN. =head1 AUTHOR Michael Fuhr =head1 SEE ALSO L, L, L, L, L, L, L =cut use strict; use File::Basename; use Net::DNS; my $res = Net::DNS::Resolver->new; if (@ARGV && ($ARGV[0] =~ /^@/)) { my $nameserver = shift; $nameserver =~ s/^@//; $res->nameservers($nameserver); } die "Usage: ", basename($0), " [ \@nameserver ] name [ type [ class ] ]\n" unless (@ARGV >= 1) && (@ARGV <= 3); my ($name, $type, $class) = @ARGV; $type ||= "A"; $class ||= "IN"; if (uc($type) eq "AXFR") { my @rrs = $res->axfr($name, $class); if (@rrs) { foreach my $rr (@rrs) { $rr->print; } } else { die "zone transfer failed: ", $res->errorstring, "\n"; } } else { my $answer = $res->send($name, $type, $class); if ($answer) { $answer->print; } else { die "query failed: ", $res->errorstring, "\n"; } } Net-DNS-1.07/demo/mx0000755000175000017500000000136013031240164013445 0ustar willemwillem#!/usr/local/bin/perl -w # $Id: mx 264 2005-04-06 09:16:15Z olaf $ =head1 NAME mx - Print a domain's MX records =head1 SYNOPSIS C I =head1 DESCRIPTION C prints a domain's MX records, sorted by preference. =head1 AUTHOR Michael Fuhr =head1 SEE ALSO L, L, L, L, L, L, L =cut use strict; use File::Basename; use Net::DNS; die "Usage: ", basename($0), " domain\n" unless (@ARGV == 1); my $dname = $ARGV[0]; my $res = Net::DNS::Resolver->new; my @mx = mx($res, $dname); if (@mx) { foreach my $rr (@mx) { print $rr->preference, "\t", $rr->exchange, "\n"; } } else { print "Can't find MX hosts for $dname: ", $res->errorstring, "\n"; } Net-DNS-1.07/demo/check_soa0000755000175000017500000001016213031240164014740 0ustar willemwillem#!/usr/local/bin/perl -w # $Id: check_soa 264 2005-04-06 09:16:15Z olaf $ =head1 NAME check_soa - Check a domain's nameservers =head1 SYNOPSIS B I =head1 DESCRIPTION B queries each of a domain's nameservers for the Start of Authority (SOA) record and prints the serial number. Errors are printed for nameservers that couldn't be reached or didn't answer authoritatively. =head1 AUTHOR The original Bourne Shell and C versions were printed in I by Paul Albitz & Cricket Liu. This Perl version was written by Michael Fuhr . =head1 SEE ALSO L, L, L, L, L, L, L =cut use File::Basename; use Net::DNS; use strict; #------------------------------------------------------------------------------ # Get the domain from the command line. #------------------------------------------------------------------------------ die "Usage: ", basename($0), " domain\n" unless @ARGV == 1; my ($domain) = @ARGV; #------------------------------------------------------------------------------ # Find all the nameservers for the domain. #------------------------------------------------------------------------------ my $res = Net::DNS::Resolver->new(); $res->defnames(0); $res->retry(2); my $ns_req = $res->query($domain, "NS"); die "No nameservers found for $domain: ", $res->errorstring, "\n" unless defined($ns_req) and ($ns_req->header->ancount > 0); # Send out non-recursive queries $res->recurse(0); # Do not buffer standard out $| = 1; #------------------------------------------------------------------------------ # Check the SOA record on each nameserver. #------------------------------------------------------------------------------ foreach my $nsrr (grep {$_->type eq "NS" } $ns_req->answer) { #---------------------------------------------------------------------- # Set the resolver to query this nameserver. #---------------------------------------------------------------------- my $ns = $nsrr->nsdname; # In order to lookup the IP(s) of the nameserver, we need a Resolver # object that is set to our local, recursive nameserver. So we create # a new object just to do that. my $local_res = Net::DNS::Resolver->new(); my $a_req = $local_res->query($ns, 'A'); unless ($a_req) { warn "Can not find address for $ns: ", $res->errorstring, "\n"; next; } foreach my $ip (map { $_->address } grep { $_->type eq 'A' } $a_req->answer) { #---------------------------------------------------------------------- # Ask this IP. #---------------------------------------------------------------------- $res->nameservers($ip); print "$ns ($ip): "; #---------------------------------------------------------------------- # Get the SOA record. #---------------------------------------------------------------------- my $soa_req = $res->send($domain, 'SOA', 'IN'); unless (defined($soa_req)) { warn $res->errorstring, "\n"; next; } #---------------------------------------------------------------------- # Is this nameserver authoritative for the domain? #---------------------------------------------------------------------- unless ($soa_req->header->aa) { warn "isn't authoritative for $domain\n"; next; } #---------------------------------------------------------------------- # We should have received exactly one answer. #---------------------------------------------------------------------- unless ($soa_req->header->ancount == 1) { warn "expected 1 answer, got ", $soa_req->header->ancount, "\n"; next; } #---------------------------------------------------------------------- # Did we receive an SOA record? #---------------------------------------------------------------------- unless (($soa_req->answer)[0]->type eq "SOA") { warn "expected SOA, got ", ($soa_req->answer)[0]->type, "\n"; next; } #---------------------------------------------------------------------- # Print the serial number. #---------------------------------------------------------------------- print "has serial number ", ($soa_req->answer)[0]->serial, "\n"; } } 0; Net-DNS-1.07/demo/example_recurse.pl0000755000175000017500000000052313031240164016616 0ustar willemwillem#!/usr/local/bin/perl -w # Example usage for Net::DNS::Resolver::Recurse # Performs recursion for a query. use Net::DNS::Resolver::Recurse; my $res = Net::DNS::Resolver::Recurse->new; $res->debug(1); $res->hints("198.41.0.4"); # A.ROOT-SERVER.NET. my $packet = $res->query_dorecursion("www.rob.com.au.", "A"); $packet && $packet->print; Net-DNS-1.07/demo/trace_dns.pl0000755000175000017500000000055113031240164015376 0ustar willemwillem#!/usr/local/bin/perl use strict; use warnings; use Net::DNS; use Net::DNS::Resolver::Recurse; my $res = Net::DNS::Resolver::Recurse->new; $res->recursion_callback(sub { my $packet = shift; $_->print for $packet->additional; printf(";; Received %d bytes from %s\n\n", $packet->answersize, $packet->answerfrom); }); $res->query_dorecursion(@ARGV); Net-DNS-1.07/demo/check_zone0000755000175000017500000000662013031240164015135 0ustar willemwillem#!/usr/local/bin/perl -w # $Id: check_zone 264 2005-04-06 09:16:15Z olaf $ =head1 NAME check_zone - Check a DNS zone for errors =head1 SYNOPSIS C [ C<-r> ] I [ I ] =head1 DESCRIPTION Checks a DNS zone for errors. Current checks are: =over 4 =item * Checks that all A records have corresponding PTR records. =item * Checks that hosts listed in NS, MX, and CNAME records have A records. =back =head1 OPTIONS =over 4 =item C<-r> Perform a recursive check on subdomains. =back =head1 AUTHOR Michael Fuhr =head1 SEE ALSO L, L, L, L, L, L, L =cut use strict; use vars qw($opt_r); use Getopt::Std; use File::Basename; use IO::Socket; use Net::DNS; getopts("r"); die "Usage: ", basename($0), " [ -r ] domain [ class ]\n" unless (@ARGV >= 1) && (@ARGV <= 2); check_domain(@ARGV); exit; sub check_domain { my ($domain, $class) = @_; $class ||= "IN"; print "-" x 70, "\n"; print "$domain (class $class)\n"; print "\n"; my $res = Net::DNS::Resolver->new; $res->defnames(0); $res->retry(2); my $nspack = $res->query($domain, "NS", $class); unless (defined($nspack)) { warn "Couldn't find nameservers for $domain: ", $res->errorstring, "\n"; return; } print "nameservers (will request zone from first available):\n"; my $ns; foreach $ns (grep { $_->type eq "NS" } $nspack->answer) { print "\t", $ns->nsdname, "\n"; } print "\n"; $res->nameservers(map { $_->nsdname } grep { $_->type eq "NS" } $nspack->answer); my @zone = $res->axfr($domain, $class); unless (@zone) { warn "Zone transfer failed: ", $res->errorstring, "\n"; return; } print "checking PTR records\n"; check_ptr($domain, $class, @zone); print "\n"; print "checking NS records\n"; check_ns($domain, $class, @zone); print "\n"; print "checking MX records\n"; check_mx($domain, $class, @zone); print "\n"; print "checking CNAME records\n"; check_cname($domain, $class, @zone); print "\n"; if ($opt_r) { print "checking subdomains\n\n"; my %subdomains; foreach (grep { $_->type eq "NS" and $_->name ne $domain } @zone) { $subdomains{$_->name} = 1; } foreach (sort keys %subdomains) { check_domain($_, $class); } } } sub check_ptr { my ($domain, $class, @zone) = @_; my $res = Net::DNS::Resolver->new; my $rr; foreach $rr (grep { $_->type eq "A" } @zone) { my $host = $rr->name; my $addr = $rr->address; my $ans = $res->send($addr, "A", $class); print "\t$host ($addr) has no PTR record\n" if ($ans->header->ancount < 1); } } sub check_ns { my ($domain, $class, @zone) = @_; my $res = Net::DNS::Resolver->new; my $rr; foreach $rr (grep { $_->type eq "NS" } @zone) { my $ans = $res->send($rr->nsdname, "A", $class); print "\t", $rr->nsdname, " has no A record\n" if ($ans->header->ancount < 1); } } sub check_mx { my ($domain, $class, @zone) = @_; my $res = Net::DNS::Resolver->new; my $rr; foreach $rr (grep { $_->type eq "MX" } @zone) { my $ans = $res->send($rr->exchange, "A", $class); print "\t", $rr->exchange, " has no A record\n" if ($ans->header->ancount < 1); } } sub check_cname { my ($domain, $class, @zone) = @_; my $res = Net::DNS::Resolver->new; my $rr; foreach $rr (grep { $_->type eq "CNAME" } @zone) { my $ans = $res->send($rr->cname, "A", $class); print "\t", $rr->cname, " has no A record\n" if ($ans->header->ancount < 1); } } Net-DNS-1.07/demo/axfr0000755000175000017500000001062713031240164013767 0ustar willemwillem#!/usr/local/bin/perl -w # $Id: axfr 264 2005-04-06 09:16:15Z olaf $ use strict; use vars qw($opt_f $opt_q $opt_s $opt_D); use File::Basename; use Getopt::Std; use Net::DNS; use Storable; #------------------------------------------------------------------------------ # Read any command-line options and check syntax. #------------------------------------------------------------------------------ getopts("fqsD:"); die "Usage: ", basename($0), " [ -fqs ] [ -D directory ] [ \@nameserver ] zone\n" unless (@ARGV >= 1) && (@ARGV <= 2); #------------------------------------------------------------------------------ # Get the nameserver (if specified) and set up the zone transfer directory # hierarchy. #------------------------------------------------------------------------------ my $nameserver = ($ARGV[0] =~ /^@/) ? shift @ARGV : ""; $nameserver =~ s/^@//; my $zone = shift @ARGV; my $basedir = defined $opt_D ? $opt_D : $ENV{"HOME"} . "/.dns-zones"; my $zonedir = join("/", reverse(split(/\./, $zone))); my $zonefile = $basedir . "/" . $zonedir . "/axfr"; # Don't worry about the 0777 permissions here - the current umask setting # will be applied. unless (-d $basedir) { mkdir($basedir, 0777) or die "can't mkdir $basedir: $!\n"; } my $dir = $basedir; my $subdir; foreach $subdir (split(m#/#, $zonedir)) { $dir .= "/" . $subdir; unless (-d $dir) { mkdir($dir, 0777) or die "can't mkdir $dir: $!\n"; } } #------------------------------------------------------------------------------ # Get the zone. #------------------------------------------------------------------------------ my $res = Net::DNS::Resolver->new; $res->nameservers($nameserver) if $nameserver; my (@zone, $zoneref); if (-e $zonefile && !defined $opt_f) { $zoneref = retrieve($zonefile) || die "couldn't retrieve zone from $zonefile: $!\n"; #---------------------------------------------------------------------- # Check the SOA serial number if desired. #---------------------------------------------------------------------- if (defined $opt_s) { my($serial_file, $serial_zone); my $rr; foreach $rr (@$zoneref) { if ($rr->type eq "SOA") { $serial_file = $rr->serial; last; } } die "no SOA in $zonefile\n" unless defined $serial_file; my $soa = $res->query($zone, "SOA"); die "couldn't get SOA for $zone: ", $res->errorstring, "\n" unless defined $soa; foreach $rr ($soa->answer) { if ($rr->type eq "SOA") { $serial_zone = $rr->serial; last; } } if ($serial_zone != $serial_file) { $opt_f = 1; } } } else { $opt_f = 1; } if (defined $opt_f) { @zone = $res->axfr($zone); die "couldn't transfer zone: ", $res->errorstring, "\n" unless @zone; store \@zone, $zonefile or die "couldn't store zone to $zonefile: $!\n"; $zoneref = \@zone; } #------------------------------------------------------------------------------ # Print the records in the zone. #------------------------------------------------------------------------------ unless ($opt_q) { $_->print for @$zoneref } __END__ =head1 NAME axfr - Perform a DNS zone transfer =head1 SYNOPSIS B S<[ B<-fqs> ]> S<[ B<-D> I ]> S<[ B<@>I ]> I =head1 DESCRIPTION B performs a DNS zone transfer, prints each record to the standard output, and stores the zone to a file. If the zone has already been stored in a file, B will read the file instead of performing a zone transfer. Zones will be stored in a directory hierarchy. For example, the zone transfer for foo.bar.com will be stored in the file $HOME/.dns-zones/com/bar/foo/axfr. The directory can be changed with the B<-D> option. This programs requires that the Storable module be installed. =head1 OPTIONS =over 4 =item B<-f> Force a zone transfer, even if the zone has already been stored in a file. =item B<-q> Be quiet -- don't print the records from the zone. =item B<-s> Perform a zone transfer if the SOA serial number on the nameserver is different than the serial number in the zone file. =item B<-D> I Store zone files under I instead of the default directory (see L<"FILES">). =item B<@>I Query I instead of the default nameserver. =back =head1 FILES =over 4 =item B<$HOME/.dns-zones> Default directory for storing zone files. =back =head1 AUTHOR Michael Fuhr =head1 SEE ALSO L, L, L, L, L, L, L, L =cut Net-DNS-1.07/demo/mresolv0000755000175000017500000000656213031240164014521 0ustar willemwillem#!/usr/local/bin/perl -w # $Id: mresolv 264 2005-04-06 09:16:15Z olaf $ =head1 NAME mresolv - Perform multiple DNS lookups in parallel =head1 SYNOPSIS B S<[ B<-d> ]> S<[ B<-n> I ]> S<[ B<-t> I ]> S<[ I... ]> =head1 DESCRIPTION B performs multiple DNS lookups in parallel. Names to query are read from the list of files given on the command line, or from the standard input. =head1 OPTIONS =over 4 =item B<-d> Turn on debugging output. =item B<-n> I Set the number of queries to have outstanding at any time. =item B<-t> I Set the timeout in seconds. If no replies are received for this amount of time, all outstanding queries will be flushed and new names will be read from the input stream. =back =head1 COPYRIGHT Copyright (c) 1997-2000 Michael Fuhr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L, L, L, L =cut use Net::DNS; use IO::Select; use Getopt::Std; use strict; use vars qw($opt_d $opt_n $opt_t); $| = 1; $opt_n = 32; # number of requests to have outstanding at any time $opt_t = 15; # timeout (seconds) getopts("dn:t:"); my $res = Net::DNS::Resolver->new; my $sel = IO::Select->new; my $eof = 0; while (1) { my $name; my $sock; #---------------------------------------------------------------------- # Read names until we've filled our quota of outstanding requests. #---------------------------------------------------------------------- while (!$eof && $sel->count < $opt_n) { print "DEBUG: reading..." if defined $opt_d; $name = <>; unless ($name) { print "EOF.\n" if defined $opt_d; $eof = 1; last; } chomp $name; $sock = $res->bgsend($name); $sel->add($sock); print "name = $name, outstanding = ", $sel->count, "\n" if defined $opt_d; } #---------------------------------------------------------------------- # Wait for any replies. Remove any replies from the outstanding pool. #---------------------------------------------------------------------- my @ready; my $timed_out = 1; print "DEBUG: waiting for replies\n" if defined $opt_d; for (@ready = $sel->can_read($opt_t); @ready; @ready = $sel->can_read(0)) { $timed_out = 0; print "DEBUG: replies received: ", scalar @ready, "\n" if defined $opt_d; foreach $sock (@ready) { print "DEBUG: handling a reply\n" if defined $opt_d; $sel->remove($sock); my $ans = $res->bgread($sock); next unless $ans; my $rr; foreach $rr ($ans->answer) { $rr->print; } } } #---------------------------------------------------------------------- # If we timed out waiting for replies, remove all entries from the # outstanding pool. #---------------------------------------------------------------------- if ($timed_out) { print "DEBUG: timeout: clearing the outstanding pool.\n" if defined $opt_d; my $sock; foreach $sock ($sel->handles) { $sel->remove($sock); } } print "DEBUG: outstanding = ", $sel->count, ", eof = $eof\n" if defined $opt_d; #---------------------------------------------------------------------- # We're done if there are no outstanding queries and we've read EOF. #---------------------------------------------------------------------- last if ($sel->count == 0) && $eof; } Net-DNS-1.07/Makefile.PL0000644000175000017500000001357513031240164014134 0ustar willemwillem# # $Id: Makefile.PL 1521 2016-12-19 15:42:18Z willem $ -*-perl-*- # BEGIN { die < 'Net::DNS', VERSION_FROM => 'lib/Net/DNS.pm', ABSTRACT_FROM => 'lib/Net/DNS.pm', AUTHOR => 'Olaf Kolkman et al', LICENSE => 'mit', MIN_PERL_VERSION => 5.004_04, ); my %platform = ( ## platform-specific dependencies MSWin32 => { 'Win32::IPHelper' => 0.07, 'Win32::API' => 0.55, 'Win32::TieRegistry' => 0.24, } ); my $platform = $platform{$^O} || {}; my %prerequisite = ( 'Digest::HMAC' => 1.03, 'Digest::MD5' => 2.13, 'Digest::SHA' => 5.23, 'File::Spec' => 0.86, 'IO::Socket' => 1.16, 'MIME::Base64' => 2.11, 'Time::Local' => 1.19, 'Test::More' => 0.52, %$platform ); my %optional = ( 'Net::DNS::SEC' => 1.01, ## For information only 'Digest::BubbleBabble' => 0.01, 'Digest::GOST' => 0.06, 'IO::Socket::INET6' => 2.51, 'IO::Socket::IP' => 0.32, 'Net::LibIDN' => 0.12, 'Scalar::Util' => 1.25, ); my @debris = qw( t/IPv6.enabled t/online.enabled t/online.nonfatal zone[0-9].txt zone[0-9][0-9].txt ); delete $optional{'Net::DNS::SEC'}; ## Note: MUST NOT be installed automatically # clean up existing makefile unlink('Makefile'); WriteMakefile( ## Makefile & distribution metadata %metadata, PREREQ_PM => {%prerequisite}, META_MERGE => {recommends => {%optional}}, clean => {FILES => "@debris"}, ); for my $module ( keys %optional ) { ## check optional module availability delete $optional{$module} unless eval "require $module"; } # clean up the online testing flag file. unlink("t/online.enabled"); unlink("t/online.disabled"); # clean up the IPv6 testing flag file. unlink("t/IPv6.enabled"); unlink("t/IPv6.disabled"); # # Get the command line args # my $help = 0; my $IPv6_tests; my $online_tests = 2; ## 2 = non-fatal, 1 = on, 0 = off ## my @options = ( 'online-tests!' => \$online_tests, 'non-fatal-online-tests' => sub { $online_tests = 2; }, 'IPv6-tests!' => \$IPv6_tests, 'help!' => \$help ); unless ( GetOptions(@options) ) { print "Error: Unrecognized option.\n"; print "Try perl Makefile.PL --help for more information\n"; exit 1; } if ($help) { print <new( PeerAddr => "www.google.com:80", Timeout => 10 ); unless ($socket) { $online_tests = 0; print <$enable" ) || die "Can't touch $enable $!"; close(ENABLED) || die "Can't touch $enable $!"; if ( $online_tests == 2 ) { my $nonfatal = 't/online.nonfatal'; open( NONFATAL, ">$nonfatal" ) || die "Can't touch $nonfatal $!"; close(NONFATAL) || die "Can't touch $nonfatal $!"; print "\nActivating Non Fatal Online Tests...\n"; } else { print "\nActivating Online Tests...\n"; } $IPv6_tests = 1 unless defined $IPv6_tests; if ( $optional{'IO::Socket::IP'} || $optional{'IO::Socket::INET6'} ) { if ($IPv6_tests) { my $enable = 't/IPv6.enabled'; print "\nActivating IPv6 Tests...\n"; open( ENABLED, ">$enable" ) || die "Can't touch $enable $!"; close(ENABLED) || die "Can't touch $enable $!"; } } print < scalar eval 'require Net::DNS; $Net::DNS::VERSION < 1.00'; sub install { return shift->SUPER::install(@_) unless NOINSTALL; return <<'END'; install : $(NOECHO) $(ECHO) "## Makefile supports test build only" $(NOECHO) $(ECHO) "## (see message from Makefile.PL)" $(NOECHO) $(FALSE) END } sub postamble { return <<'END'; test_cover : pure_all cover -delete HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test cover -summary END } exit unless NOINSTALL; my @installed = grep $_ =~ m/\WNet\WDNS.pm$/i, values %INC; warn <<"END"; ## ## The install location for this version of Net::DNS may differ ## from the existing version $Net::DNS::VERSION in your perl library. ## ## Version $Net::DNS::VERSION will usually occur earlier in the library ## search path, rendering the upgrade installation ineffective. ## ## The conflict can be resolved by removing the old version ## @installed ## ## Makefile has been generated to support build and test only. ## END __END__ Net-DNS-1.07/META.yml0000644000175000017500000000147513031240175013431 0ustar willemwillem--- abstract: 'Perl Interface to the Domain Name System' author: - 'Olaf Kolkman et al' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.18, CPAN::Meta::Converter version 2.143240' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-DNS no_index: directory: - t - inc recommends: Digest::BubbleBabble: '0.01' Digest::GOST: '0.06' IO::Socket::INET6: '2.51' IO::Socket::IP: '0.32' Net::LibIDN: '0.12' Scalar::Util: '1.25' requires: Digest::HMAC: '1.03' Digest::MD5: '2.13' Digest::SHA: '5.23' File::Spec: '0.86' IO::Socket: '1.16' MIME::Base64: '2.11' Test::More: '0.52' Time::Local: '1.19' perl: '5.00404' version: '1.07' Net-DNS-1.07/contrib/0000755000175000017500000000000013031240175013611 5ustar willemwillemNet-DNS-1.07/contrib/find_zonecut0000755000175000017500000000171013031240164016223 0ustar willemwillem#!/usr/bin/perl $VERSION = (qw$LastChangedRevision: 1251 $)[1] || 0.01; =head1 NAME find_zonecut - Find zonecut for a domain name =head1 SYNOPSIS find_zonecut name =head1 DESCRIPTION B returns the name of the closest delegation point to the specified domain name. =cut use strict; use Net::DNS; my $resolver = new Net::DNS::Resolver(); print find_zonecut(shift), "\n"; sub find_zonecut { ## Copyright (c)2014 Dick Franks my $name = shift; my $reply = $resolver->send( "*.$name", 'NULL' ) || die $resolver->errorstring; my ($cut) = map $_->name, $reply->authority; return $cut || die "failed to find zone cut for $name"; } __END__ =head1 COPYRIGHT (c)2014 Dick Franks Erwfranks[...]acm.orgE All rights reserved. This program is free software; you may use or redistribute it under the same terms as Perl itself. FOR DEMONSTRATION PURPOSES ONLY, NO WARRANTY, NO SUPPORT =head1 SEE ALSO L, L =cut Net-DNS-1.07/contrib/README0000644000175000017500000000110113031240164014460 0ustar willemwillemThis directory contains contributed scripts and modules that use Net::DNS. The Net::DNS author assumes no responsibility for them -- if you have problems or questions, please contact the contributor. File Contributor ------ ----------- check_soa Dick Franks check_zone Dennis Glatting find_zonecut Dick Franks loc2earth.fcgi Christopher Davis loclist.pl Christopher Davis --- $Id: README 1251 2014-08-18 10:18:23Z willem $ Net-DNS-1.07/contrib/dnswalk.README0000644000175000017500000000024313031240164016130 0ustar willemwillem$Id: dnswalk.README 739 2008-12-17 13:48:03Z olaf $ Dave Barr's dnswalk now uses Net::DNS. You can get a copy from: http://sourceforge.net/projects/dnswalk/ Net-DNS-1.07/contrib/check_soa0000755000175000017500000004057413031240164015466 0ustar willemwillem#!/usr/bin/perl $VERSION = (qw$LastChangedRevision: 1507 $)[1]; =head1 NAME check_soa - Check nameservers for a domain =head1 SYNOPSIS check_soa [-d] [-n] [-s] [-t] [-v] domain [nameserver] =head1 DESCRIPTION B builds a list of nameservers for the zone which contains the specified domain name. The program queries each nameserver for the relevant SOA record and reports the zone serial number. Error reports are generated for nameservers which reply with incorrect, non-authoritative or outdated information. =over 8 =item I Fully qualified domain name to be tested. Domains within ip6.arpa or in-addr.arpa namespaces may be specified using the appropriate IP address or prefix notation. =item I Optional name or list of IP addresses of specific nameserver to be tested. Addresses are used in the sequence they appear in the argument list. =back SOA query packets are sent to the nameservers as rapidly as the underlying hardware will allow. The program waits for a response only when it is needed for analysis. Execution time is determined by the slowest nameserver. This perldoc(1) documentation page is displayed if the I argument is omitted. The program is based on the B idea described by Albitz and Liu. =head1 OPTIONS =over 8 =item B<-d> Turn on resolver diagnostics. =item B<-n> Report negative cache TTL. =item B<-s> Request DNSSEC resource records. =item B<-t> Ignore UDP datagram truncation. =item B<-v> Verbose output including address records for each nameserver. =back =head1 EXAMPLES =over 8 =item check_soa example.com Query all nameservers for the specified domain. =item check_soa 192.0.2.1 Query nameservers for the corresponding in-addr.arpa subdomain. =item check_soa 2001:DB8::8:800:200C:417A Query nameservers for the corresponding ip6.arpa subdomain. =item check_soa 2001:DB8:0:CD30::/60 As above, for IPv6 address prefix of specified length. =item check_soa 192.0.2.1 z.arin.net Query specific nameserver as above. =back =head1 BUGS The program can become confused by zones which originate, or appear to originate, from more than one primary server. The timeout code uses the perl 4-argument select() function. This is not guaranteed to work in non-Unix environments. =head1 COPYRIGHT (c) 2003-2011 Dick Franks Erwfranks[...]acm.orgE All rights reserved. This program is free software; you may use or redistribute it under the same terms as Perl itself. =head1 SEE ALSO Paul Albitz, Cricket Liu. DNS and BIND, 5th Edition. O'Reilly, 2006. Andrews, M., Locally Served DNS Zones, RFC6303, IETF, 2011. Andrews, M., Negative Caching of DNS Queries, RFC2308, IETF Network Working Group, 1998. Elz, R., Bush, R., Clarifications to the DNS Specification, RFC2181, IETF Network Working Group, 1997. Mockapetris, P., Domain Names - Implementation and Specification, RFC 1035, USC/ISI, 1987. Larry Wall, Tom Christiansen, Jon Orwant. Programming Perl, 3rd Edition. O'Reilly, 2000. =cut use strict; my $self = $0; # script my $options = 'dnstv'; # options my %option; eval { require Getopt::Std; Getopt::Std::getopts( $options, \%option ) }; warn "Can't locate Getopt::Std\n" if $@; my @arg = qw( domain [nameserver] ); # arguments my @flag = map "[-$_]", split( //, $options ); # documentation die eval { system("perldoc -F $self"); "" }, < ( $option{d} || 0 ), # -d enable diagnostics igntc => ( $option{t} || 0 ) # -t ignore truncation ); my $negtest = $option{n}; # -n report NCACHE TTL my $dnssec = $option{s}; # -s request DNSSEC RRs my $verbose = $option{v}; # -v verbose my $neg_min = 300; # NCACHE TTL reporting threshold my $neg_max = 86400; # NCACHE TTL reporting threshold my $udp_timeout = 5; # timeout for concurrent queries my $udp_wait = 0.100; # minimum polling interval local $SIG{__WARN__} = sub { }; # suppress all warnings my $resolver = new Net::DNS::Resolver(@conf); # create resolver object $resolver->nameservers(@nameserver) or die $resolver->string; my ($question) = new Net::DNS::Packet($domain)->question; # invert IP address/prefix my $name = lc $question->qname; my $NetDNSrev = &Net::DNS::version; die "\tFeature not supported by Net::DNS $NetDNSrev\n" if $name =~ m#[:/\s]|\.\d+$#; my $packet = $resolver->send( "*.$name", 'NULL' ) or die $resolver->errorstring; my ($zone) = map lc( $_->name ), $packet->authority; my @ns = ( $zone or $name eq '.' ) ? NS($zone) : (); # find NS serving name die "\nno such zone: $name\n\n", $resolver->string unless @ns; # game over my @nsname = grep $_ ne $zone, map $_->nsdname, @ns; # extract server names from NS records my @server = @nameserver ? (@nameserver) : ( sort @nsname ); $resolver->dnssec(1) if $dnssec; my @soa = grep $_->type eq 'SOA', displayRR( $zone, 'SOA' ); foreach my $soa (@soa) { # simple sanity check my $owner = lc $soa->name; # zone name my $mname = lc $soa->mname; # primary server my $rname = lc $soa->rname; # responsible person my $resolved; # check MNAME resolvable foreach my $rrtype (qw( A AAAA )) { my $probe = $resolver->send( $mname, $rrtype ); last if ( $resolved = scalar $probe->answer ); } for ($mname) { last unless $_ eq $owner; # RFC6303 local zone displayRR( $zone, 'NS' ) unless @nameserver; # ensure NS always listed last unless /(in-addr|ip6)\.arpa/i; report('unexpected address record in locally served zone [RFC6303]') if $resolved; } last unless @nsname; # suppress remaining tests report( 'unresolved MNAME', $mname ) unless $resolved; unless ( $rname =~ /(@|[^\\]\.)([^@]+)$/ ) { # parse RNAME report( 'incomplete RNAME', $rname ) unless $rname eq '<>'; } elsif ( $2 ne $mname ) { my $resolved; # check RNAME resolvable foreach my $rrtype (qw( MX A AAAA CNAME )) { my $probe = $resolver->send( $2, $rrtype ); last if ( $resolved = scalar $probe->answer ); } report( 'unresolved RNAME', $rname ) unless $resolved; } if ( $soa->expire < $soa->refresh ) { # check refresh/retry timing report('slave expires zone data before scheduled refresh'); } else { my $window = $soa->expire - $soa->refresh - 1; # zone transfer window my $retry = $soa->retry || 1; # retry interval my $n = 1 + int( $window / $retry ); # number of transfer attempts my $s = $n > 1 ? 's' : ''; report("slave expires zone data after $n transfer failure$s") unless $n > 3; } my ($min) = sort { $a <=> $b } ( $soa->minimum, $soa->ttl ); # force NCACHE test for extreme TTLs $negtest++ if $min < $neg_min or $soa->minimum > $neg_max; } my @ncache = $negtest ? NCACHE($zone) : (); # report observed NCACHE TTL foreach my $rrtype (qw( A AAAA PTR )) { # nobody believes in ANY any more displayRR( $name, $rrtype ); } displayRR( $zone, 'NS' ) if @nameserver; # show NS if testing specific nameserver print "----\n"; my ( $bad, $seq, $iphash ) = checkNS( $zone, @server ); # report status $iphash->{$seq} ||= ''; print "\n"; my $s = $bad != 1 ? 's' : ''; print "Unsatisfactory response from $bad nameserver$s\n\n" if $bad and @server > 1; my %mname = reverse %$iphash; # invert address hash my $mcount = keys %mname; # number of distinct MNAMEs if ( $mcount > 1 ) { report('SOAs do not identify unique primary server'); # RFC1034, 4.3.5 foreach my $mname ( sort keys %mname ) { foreach ( $mname, $resolver->nameservers($mname) ) { delete $iphash->{$_} } } my %serial = map { ( $iphash->{$_} => $_ ) } sort { $a <=> $b } keys %$iphash; foreach ( sort keys %mname ) { report( sprintf '%10s %s', $serial{$_}, $_ ) } } exit; sub checkNS0 { ## initial status vector for checkNS my $serial = undef; my $hash = {}; my $res = new Net::DNS::Resolver(@conf); foreach my $soa ( grep $_->type eq 'SOA', @ncache, @soa ) { my $mname = lc $soa->mname; # populate hash with name/IP of primary next if $mname eq lc $soa->name; # RFC6303 local zone foreach ( $mname, $res->nameservers($mname) ) { $hash->{$_} = $mname } my $s = $soa->serial; $hash->{$s} = $mname; $serial = $s if ordered( $serial, $s ); } return ( 0, $serial, $hash ); } sub checkNS { ## query nameservers (concurrently) and report status my $zone = shift; my $index = scalar @_; # index last element my $element = pop(@_) || return checkNS0; # pop element, terminate if undef my ( $ns, $if ) = split / /, lc $element; # name + optional interface IP my $res = new Net::DNS::Resolver(@conf); # use clean resolver for each test my @xip = $res->nameservers( $if || $ns ); # point at nameserver my $ip = pop @xip; # last (or only) interface $res->nameservers($ip) if @xip; $res->recurse(0); # send non-recursive query to nameserver my ( $socket, $sent ); ( $socket, $sent ) = ( $res->bgsend( $zone, 'SOA' ), time ) if $ip; my ( $fail, $latest, $hash ) = checkNS( $zone, @_ ); # recurse to query others concurrently # pick up response as recursion unwinds my $packet; if ($socket) { until ( $res->bgisready($socket) ) { # timed wait on socket last if time > ( $sent + $udp_timeout ); delay($udp_wait); # snatch a few milliseconds sleep } $packet = $res->bgread($socket) if $res->bgisready($socket); # get response } elsif ($ip) { $packet = $res->send( $zone, 'SOA' ); # use sequential query model } my @pass = ( $fail, $latest, $hash ); # use prebuilt return values my @fail = ( $fail + 1, $latest, $hash ); my %nsaddr = $ip ? ( $ip => 1 ) : (); # special handling for multihomed server foreach my $xip (@xip) { # iterate over remaining interfaces next if $nsaddr{$xip}++; # silently ignore duplicate address record my ( $f, $x, $h ) = checkNS( $zone, (undef) x scalar(@_), "$ns $xip" ); %$hash = ( %$hash, %$h ); # merge address hashes @pass = @fail if $f; # propagate failure to caller } my $rcode; my @soa; unless ($packet) { # ... is no more! It has ceased to be! $rcode = 'no response'; } elsif ( $packet->header->rcode ne 'NOERROR' ) { $rcode = $packet->header->rcode; # NXDOMAIN or fault at nameserver } else { @soa = grep $_->type eq 'SOA', $packet->answer; foreach my $soa (@soa) { my $mname = lc $soa->mname; # hash MNAME by IP my @ip = $hash->{$mname} ? () : $res->nameservers($mname); foreach ( $mname, @ip ) { $hash->{$_} = $mname } } } my $primary = $hash->{$ip || $ns} ? '*' : ''; # flag zone primary unless ($ip) { # identify nameserver print "\n[$index]$primary\t$ns\n"; # name only $rcode = 'unresolved server name'; } elsif ( $ns eq $ip ) { print "\n[$index]$primary\t$ip\n"; # ip only } else { print "\n[$index]$primary\t$ns [$ip]\n"; # name and ip } if ($verbose) { # show PTR record my @ptr = grep $_->type eq 'PTR', $ip ? displayRR($ip) : (); my @fwd = sort map { lc $_->ptrdname } @ptr; foreach my $name ( @fwd ? @fwd : ($ns) ) { # show address records displayRR( $name, 'A' ); displayRR( $name, 'AAAA' ); } } if ($rcode) { return @pass if $ns eq lc $zone; # RFC6303 local zone report($rcode); # abject failure return @fail; } my @result = @fail; # analyse response my @auth = @soa ? () : $packet->authority; my @ncache = grep $_->type eq 'SOA', @auth; my @refer = grep $_->type eq 'NS', @auth; if (@soa) { if ( @soa > 1 ) { report('multiple SOA records'); # RFC2181, 6.1 } elsif ( $packet->header->aa ) { @result = @pass; # RFC1034, 6.2.1(1) } else { my $ttl = $soa[0]->ttl; # RFC1034, 6.2.1(2) report( 'non-authoritative answer', ttl($ttl) ); } } elsif (@ncache) { my ($ttl) = map { $_->ttl } @soa = @ncache; # RFC2308, 2.2(1)(2) report( 'NODATA response', ttl($ttl) ); return @fail unless grep $_->name =~ /^$zone$/i, @ncache; report('requested SOA in authority section; violates RFC2308'); } elsif (@refer) { my @n = grep $_->nsdname =~ /$ns/i, @refer; # RFC2308, 2.2(4) report('authoritative data expired') if @n; # self referral report('not configured for zone') unless @n; return @fail; } else { report('NODATA response from nameserver'); # RFC2308, 2.2(3) return @fail; } report('truncated response from nameserver') if $packet->header->tc; my ($serial) = map { $_->serial } @soa; # check serial number if ( $primary && ordered( $serial, $latest ) ) { # primary should have latest data my $response = $res->send( $zone, 'SOA' ); # repeat test before pointing finger my ($retest) = grep $_->type eq 'SOA', $response ? $response->answer : (); $serial = $retest->serial if ordered( $serial, $retest->serial ); } print "\t\t\tzone serial\t", $serial, "\n"; $hash->{$serial} = $hash->{$ip} if $primary; if ( ordered( $serial, $latest ) ) { report('serial number not current'); return @fail unless $primary; report('discredited as unique primary nameserver'); return @fail; } return @result if $serial == $latest; my $x = $if ? 0 : ( $index - 1 ) - $fail; # all previous out of date my $s = $x > 1 ? 's' : ''; # pedants really are revolting! report("at least $x previously unreported stale serial number$s") if $x; return ( $result[0] + $x, $serial, $hash ); # restate partial result } sub delay { ## short duration sleep my $duration = shift; # seconds sleep( 1 + $duration ) unless eval { defined select( undef, undef, undef, $duration ) }; } sub displayRR { ## print specified RRs or error code my $packet = $resolver->send(@_) or return (); # get specified RRs my $header = $packet->header; my $rcode = $header->rcode; # response code my ($question) = $packet->question; my $qtype = $question->qtype; my $qname = $question->qname; my $name = $qname =~ /^xn--/ ? eval { $question->name } : ''; my @annotation = $name ? ("; $name\n") : (); my @answer = $packet->answer; my @authority = $packet->authority; my @ncache = grep $_->type eq 'SOA', @authority; # per RFC2308 my @workaround = $qtype eq 'SOA' ? @ncache : (); # SOA misplaced/withheld? my @remark = @workaround ? qw(unexpected) : (); foreach my $rr ( @answer, @workaround ) { # print RRs unless shown elsewhere next if $qtype eq 'ANY' && $rr->type =~ /^(SOA|NS)$/; print @annotation if $rr->name eq $qname; # annotate IDN for ( $rr->string ) { my $l = $verbose ? length($_) : 108; # abbreviate long RR substr( $_, $l ) = ' ...' if length($_) > $l && $rr->type ne 'SOA'; print "$_\n"; } } report( @remark, "$rcode:", $question->string, @annotation ) if $rcode ne 'NOERROR'; return @answer; } sub NCACHE { ## report observed NCACHE TTL for domain my $domain = shift || ''; my $seq = time; my $nxdomain = "_nx_$seq.$domain"; # intentionally perverse query my $reply = $resolver->send( $nxdomain, 'PTR' ) or return (); for ( $reply->answer ) { report( 'wildcard invalidates NCACHE test:', $_->string ); return (); } my @ncache = grep $_->type eq 'SOA', $reply->authority; for (@ncache) { my $serial = $_->serial; my ($seen) = ( @soa, @ncache ); my @source = $serial > $seen->serial ? ("\t(SOA: $serial)") : (); report( 'negative cache data', ttl( $_->ttl ), @source ); } return @ncache; } sub NS { ## find NS records for domain my $name = shift; my $packet = $resolver->send( $name, 'NS' ) or die $resolver->string; my @answer = grep $_->type eq 'NS', $packet->answer; } sub ordered { ## irreflexive 32-bit partial ordering use integer; my ( $a, $b ) = @_; return defined $b unless defined $a; # ( undef, any ) return 0 unless defined $b; # ( any, undef ) # unwise to assume 32-bit arithmetic, or that integer overflow goes unpunished if ( $a < 0 ) { # translate $a<0 region $a = ( $a ^ 0x80000000 ) & 0xFFFFFFFF; # 0 <= $a < 2**31 $b = ( $b ^ 0x80000000 ) & 0xFFFFFFFF; # -2**31 <= $b < 2**32 } return $a < $b ? ( $a > ( $b - 0x80000000 ) ) : ( $b < ( $a - 0x80000000 ) ); } sub report { ## concatenate strings into fault report print '### ', join( "\t", @_ ), "\n"; } sub ttl { ## human-friendly TTL my $t = shift; my ( $s, $m, $h, $y, $d ) = ( gmtime($t) )[0 .. 2, 5, 7]; unless ( $y == 70 ) { return sprintf 'TTL %u (%uy%ud)', $t, $y - 70, $d; } elsif ($h) { return sprintf 'TTL %u (%ud%0.2uh)', $t, $d, $h if $d; return sprintf 'TTL %u (%uh%0.2um)', $t, $h, $m if $m; return sprintf 'TTL %u (%uh)', $t, $h; } else { return sprintf 'TTL %u (%ud)', $t, $d if $d; return sprintf 'TTL %u (%um%0.2us)', $t, $m, $s if $s; return sprintf 'TTL %u (%um)', $t, $m; } } __END__ Net-DNS-1.07/contrib/loc2earth.fcgi0000755000175000017500000001347013031240164016334 0ustar willemwillem#!/usr/local/bin/perl -T # loc2earth.cgi - generates a redirect to Earth Viewer based on LOC record # [ see or RFC 1876 ] # by Christopher Davis # $Id: loc2earth.fcgi 264 2005-04-06 09:16:15Z olaf $ die "I want 5.004 and I want it now" if $] < 5.004; # if you don't have FastCGI support, comment out this line and the two lines # later in the script with "NO FCGI" comments use CGI::Fast qw(:standard); # and uncomment the following instead. #use CGI qw(:standard); use Net::DNS '0.08'; # LOC support in 0.08 and later $res = new Net::DNS::Resolver; @samplehosts= ('www.kei.com', 'www.ndg.com.au', 'gw.alink.net', 'quasar.inexo.com.br', 'hubert.fukt.hk-r.se', 'sargent.cms.dmu.ac.uk', 'thales.mathematik.uni-ulm.de'); while (new CGI::Fast) { # NO FCGI -- comment out this line print header(-Title => "RFC 1876 Resources: Earth Viewer Demo"); # reinitialize these since FastCGI would keep them around otherwise @addrs = @netnames = (); $foundloc = 0; print ' RFC 1876 Resources: Earth Viewer Demo

RFC 1876 Resources

loc2earth: The Earth Viewer Demo

'; print p("This is a quick & dirty demonstration of the use of the", a({-href => 'http://www.dimensional.com/~mfuhr/perldns/'}, 'Net::DNS module'),"and the", a({-href => 'http://www-genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'}, 'CGI.pm library'), "to write LOC-aware Web applications."); print startform("GET"); print p(strong("Hostname"),textfield(-name => host, -size => 50)); print p(submit, reset), endform; if (param('host')) { ($host = param('host')) =~ s/\s//g; # strip out spaces # check for numeric IPs and do reverse lookup to get name if ($host =~ m/^\d+\.\d+\.\d+\.\d+$/) { $query = $res->query($host); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "PTR") { $host = $ans->ptrdname; } } } } $query = $res->query($host,"LOC"); if (defined ($query)) { # then we got an answer of some sort foreach $ans ($query->answer) { if ($ans->type eq "LOC") { &print_loc($ans->rdatastr); $foundloc++; } elsif ($ans->type eq "CNAME") { # XXX should follow CNAME chains here } } } if (!$foundloc) { # try the RFC 1101 search bit $query = $res->query($host,"A"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "A") { push(@addrs,$ans->address); } } } if (@addrs) { checkaddrs: foreach $ipstr (@addrs) { $ipnum = unpack("N",pack("CCCC",split(/\./,$ipstr,4))); ($ip1) = split(/\./,$ipstr); if ($ip1 >= 224) { # class D/E, treat as host addr $mask = 0xFFFFFFFF; } elsif ($ip1 >= 192) { # "class C" $mask = 0xFFFFFF00; } elsif ($ip1 >= 128) { # "class B" $mask = 0xFFFF0000; } else { # class A $mask = 0xFF000000; } $oldmask = 0; while ($oldmask != $mask) { $oldmask = $mask; $querystr = join(".", reverse (unpack("CCCC",pack("N",$ipnum & $mask)))) . ".in-addr.arpa"; $query = $res->query($querystr,"PTR"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "PTR") { # we want the list in LIFO order unshift(@netnames,$ans->ptrdname); } } $query = $res->query($querystr,"A"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "A") { $mask = unpack("L",pack("CCCC", split(/\./,$ans->address,4))); } } } } } if (@netnames) { foreach $network (@netnames) { $query = $res->query($network,"LOC"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "LOC") { &print_loc($ans->rdatastr); $foundloc++; last checkaddrs; } elsif ($ans->type eq "CNAME") { # XXX should follow CNAME chains here } } } } } } } } if (!$foundloc) { print hr,p("Sorry, there appear to be no LOC records for the", "host $host in the DNS."); } } print hr,p("Some hosts with LOC records you may want to try:"), "
    \n
  • ",join("\n
  • ",@samplehosts),"
"; print '
RFC 1876 Now
Christopher Davis <ckd@kei.com>
'; } # NO FCGI -- comment out this line sub print_loc { local($rdata) = @_; ($latdeg,$latmin,$latsec,$lathem, $londeg,$lonmin,$lonsec,$lonhem) = split (/ /,$rdata); print hr,p("The host $host appears to be at", "${latdeg}°${latmin}'${latsec}\" ${lathem}", "latitude and ${londeg}°${lonmin}'${lonsec}\"", "${lonhem} longitude according to the DNS."); $evurl = ("http://www.fourmilab.ch/cgi-bin/uncgi/Earth?" . "lat=${latdeg}d${latmin}m${latsec}s&ns=" . (($lathem eq "S")?"lSouth":"lNorth") . "&lon=${londeg}d${lonmin}m${lonsec}s&ew=" . (($lonhem eq "W")?"West":"East") . "&alt="); print "

Generate an Earth Viewer image from "; foreach $alt (49, 204, 958, 35875) { print ('', $alt,'km '); } print " above this point

"; } Net-DNS-1.07/contrib/loclist.pl0000755000175000017500000000611713031240164015625 0ustar willemwillem#!/usr/bin/perl # loclist.pl -- check a list of hostnames for LOC records # -v -- verbose output (include NO results). used to be the default # -n -- try looking for network LOC records as well (slower) # -r -- try doing reverse-resolution on IP-appearing hosts # -d -- debugging output # egrep 'loc2earth.*host' /serv/www/logs/wn.log | # perl -pe 's/^.*host=//; s/([a-zA-Z0-9.-]+).*/$1/' | # sort -u | ~/loclist.pl > loc.sites use Net::DNS '0.08'; use Getopt::Std; getopts('vnrd'); $res = new Net::DNS::Resolver; line: foreach $_ (<>) { chomp; $foundloc = $namefound = 0; next line if m/^$/; next line if m/[^\w.-\/+_]/; # /, +, _ not actually valid in hostnames print STDERR "$_ DEBUG looking up...\n" if $opt_d; if (m/^\d+\.\d+\.\d+\.\d+$/) { if ($opt_r) { $query = $res->query($_); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "PTR") { $_ = $ans->ptrdname; $namefound++; } } } } next line unless $namefound; } $query = $res->query($_,"LOC"); if (defined ($query)) { # then we got an answer of some sort foreach $ans ($query->answer) { if ($ans->type eq "LOC") { print "$_ YES ",$ans->rdatastr,"\n"; $foundloc++; } } } if ($opt_n && !$foundloc) { # try the RFC 1101 search bit @addrs = @netnames = (); $query = $res->query($_,"A"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "A") { push(@addrs,$ans->address); } } } if (@addrs) { checkaddrs: foreach $ipstr (@addrs) { $ipnum = unpack("N",pack("CCCC",split(/\./,$ipstr,4))); ($ip1) = split(/\./,$ipstr); if ($ip1 >= 224) { # class D/E, treat as host addr $mask = 0xFFFFFFFF; } elsif ($ip1 >= 192) { # "class C" $mask = 0xFFFFFF00; } elsif ($ip1 >= 128) { # "class B" $mask = 0xFFFF0000; } else { # class A $mask = 0xFF000000; } $oldmask = 0; while ($oldmask != $mask) { $oldmask = $mask; $querystr = join(".", reverse (unpack("CCCC",pack("N",$ipnum & $mask)))) . ".in-addr.arpa"; $query = $res->query($querystr,"PTR"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "PTR") { # we want the list in LIFO order unshift(@netnames,$ans->ptrdname); } } $query = $res->query($querystr,"A"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "A") { $mask = unpack("L",pack("CCCC", split(/\./,$ans->address,4))); } } } } } if (@netnames) { foreach $network (@netnames) { $query = $res->query($network,"LOC"); if (defined ($query)) { foreach $ans ($query->answer) { if ($ans->type eq "LOC") { print "$_ YES ",$ans->rdatastr,"\n"; $foundloc++; last checkaddrs; } elsif ($ans->type eq "CNAME") { # XXX should follow CNAME chains here } } } } } } } } if ($opt_v && !$foundloc) { print "$_ NO\n"; } } Net-DNS-1.07/contrib/check_zone0000755000175000017500000004526513031240164015661 0ustar willemwillem#!/usr/local/bin/perl -w # $Id: check_zone 638 2007-05-15 18:59:26Z olaf $ =head1 NAME check_zone - Check a DNS zone for errors =head1 SYNOPSIS C [ C<-r> ][ C<-v> ] I [ I ] =head1 DESCRIPTION Checks a DNS zone for errors. Current checks are: =over 4 =item * Checks the domain's SOA from each of the domain's name servers. The SOA serial numbers should match. This program's output cannot be trusted if they do not. =item * Tries to perform an AXFR from each of the domain's name servers. This test helps to detect whether the name server is blocking AXFR. =item * Checks that all A records have corresponding PTR records. For each A record its PTR's name is match checked. =item * Checks that all PTR records match an A record (sometimes they match a CNAME). Check the PTR's name against the A record. =item * Checks that hosts listed in NS, MX, and CNAME records have A records. Checks for NS and CNAME records not pointing to another CNAME (i.e., they must directly resolve to an A record). That test may be somewhat controversial because, in many cases, a MX to a CNAME or a CNAME to another CNAME will resolve; however, in DNS circles it isn't a recommended practise. =item * Check each record processed for being with the class requested. This is an internal integrity check. =back =head1 OPTIONS =over 4 =back =item C<-r> Perform a recursive check on subdomains. =item C<-v> Verbose. =item C<-a alternate_domain> Treat as equal to . This is useful when supporting a change of domain names (eg from myolddomain.example.net to mynewdomain.example.net) where the PTR records can point to only one of the two supported domains (which are otherwise identical). =item C<-e exception_file> Ignore exceptions in file . File format can be space-separated domain pairs, one pair per line, or it can be straight output from this program itself (for simple cut-and-paste functionality). This allows for skipping entries that are odd or unusual, but not causing problems. Note: this only works with A - PTR checks. =head1 AUTHORS Originally developed by Michael Fuhr (mfuhr@dimensional.com) and hacked--with furor--by Dennis Glatting (dennis.glatting@software-munitions.com). "-a" and "-e" options added by Paul Archer =head1 COPYRIGHT =head1 SEE ALSO L, L, L, L, L, L =head1 BUGS A query for an A RR against a name that is a CNAME may not follow the CNAME to an A RR. There isn't a mechanism to insure records are returned from an authoritative source. There appears to be a bug in the resolver AXFR routine where, if one server cannot be contacted, the routine doesn't try another in its list. =cut require 'assert.pl'; use strict; use vars qw($opt_r); use vars qw($opt_v); use vars qw($opt_a); use vars qw($opt_e); use Getopt::Std; use File::Basename; use IO::Socket; use Net::DNS; getopts("rva:e:"); die "Usage: ", basename($0), " [ -r -v ] [ -a alternate_domain] [ -e eqivalent_domains_file ] domain [ class ]\n" unless (@ARGV >= 1) && (@ARGV <= 2); our $exit_status = 0; $SIG{__WARN__} = sub {$exit_status=1 ; print STDERR @_ }; $opt_r = 1; our $main_domain=$ARGV[0]; our %exceptions = parse_exceptions_file(); foreach my $key (sort keys %exceptions) { print "$key:\t"; foreach my $val (@{$exceptions{$key}}) { print "$val "; } print "\n"; } check_domain(@ARGV); exit $exit_status; sub parse_exceptions_file { my %exceptions; my $file = $opt_e || ""; return %exceptions unless ( -r $file); open FH, $file or warn "Couldn't read $file: $!"; my $line; while ( defined ($line = ) ) { chomp $line; #print " raw line: $line\n"; next if $line =~ /^\s*#/; $line =~ s/#.*$//; $line =~ s/^\s*//; $line =~ s/\s*$//; $line =~ s/'//g; my ($left, $right) = (split /[\s:]+/, $line)[0, -1]; push @{$exceptions{$left}}, $right; #print "processed line: $line\n"; } return %exceptions; } sub check_domain { my ( $domain, $class ) = @_; my $ns; my @zone; $class ||= "IN"; print "-" x 70, "\n"; print "$domain (class $class)\n"; print "\n"; my $res = new Net::DNS::Resolver; $res->defnames( 0 ); $res->retry( 2 ); my( $nspack, $ns_rr, @nsl ); # Get a list of name servers for the domain. # Error-out if the query isn't satisfied. # $nspack = $res->query( $domain, 'NS', $class ); unless( defined( $nspack )) { warn "Couldn't find nameservers for $domain: ", $res->errorstring, "\n"; return; } printf( "List of name servers returned from '%s'\n", $res->answerfrom ); foreach $ns_rr ( $nspack->answer ) { $ns_rr->print if( $opt_v ); assert( $class eq $ns_rr->class ); assert( 'NS' eq $ns_rr->type ); if( $ns_rr->name eq $domain ) { print "\t", $ns_rr->rdatastr, "\n"; push @nsl, $ns_rr->rdatastr; } else { warn( "asked for '$domain', got '%s'\n", $ns_rr->rdatastr ); } } print "\n"; warn( "\tZone has no NS records\n" ) if( scalar( @nsl ) == 0 ); # Transfer the zone from each of the name servers. # The zone is transferred for several reasons. # First, so the check routines won't (an efficiency # issue) and second, to see if we can. # $res->nameservers( @nsl ); foreach $ns ( @nsl ) { $res->nameservers( $ns ); my @local_zone = $res->axfr( $domain, $class ); unless( @local_zone ) { warn "Zone transfer from '", $ns, "' failed: ", $res->errorstring, "\n"; } @zone = @local_zone if( ! @zone ); } # Query each name server for the zone # and check the zone's SOA serial number. # print "checking SOA records\n"; check_soa( $domain, $class, \@nsl ); print "\n"; # Check specific record types. # print "checking NS records\n"; check_ns( $domain, $class, \@nsl, \@zone ); print "\n"; print "checking A records\n"; check_a( $domain, $class, \@nsl, \@zone ); print "\n"; print "checking PTR records\n"; check_ptr( $domain, $class, \@nsl, \@zone ); print "\n"; print "checking MX records\n"; check_mx( $domain, $class, \@nsl, \@zone ); print "\n"; print "checking CNAME records\n"; check_cname( $domain, $class, \@nsl, \@zone ); print "\n"; # Recurse? # if( $opt_r ) { my %subdomains; print "checking subdomains\n\n"; # Get a list of NS records from the zone that # are not for the zone (i.e., they're subdomains). # foreach ( grep { $_->type eq 'NS' and $_->name ne $domain } @zone ) { $subdomains{$_->name} = 1; } # For each subdomain, check it. # foreach ( sort keys %subdomains ) { check_domain($_, $class); } } } sub check_soa { my( $domain, $class, $nsl ) = @_; my( $soa_sn, $soa_diff ) = ( 0, 0 ); my( $ns, $soa_rr ); my $rr_count = 0; my $res = new Net::DNS::Resolver; $res->defnames( 0 ); $res->retry( 2 ); $res->recurse( 0 ); # Contact each name server and get the # SOA for the somain. # foreach $ns ( @$nsl ) { my $soa = 0; my $nspack; # Query the name server and test # for a result. # $res->nameservers( $ns ); $nspack = $res->query( $domain, "SOA", $class ); unless( defined( $nspack )) { warn "Couldn't get SOA from '$ns'\n"; next; } # Look at each SOA for the domain from the # name server. Specifically, look to see if # its serial number is different across # the name servers. # foreach $soa_rr ( $nspack->answer ) { $soa_rr->print if( $opt_v ); assert( $class eq $soa_rr->class ); assert( 'SOA' eq $soa_rr->type ); print "\t$ns:\t", $soa_rr->serial, "\n"; # If soa_sn is zero then an SOA serial number # hasn't been recorded. In that case record # the serial number. If the serial number # doesn't match a previously recorded one then # indicate they are different. # # If the serial numbers are different then you # cannot really trust the remainder of the test. # if( $soa_sn ) { $soa_diff = 1 if ( $soa_sn != $soa_rr->serial ); } else { $soa_sn = $soa_rr->serial; } } ++$rr_count; } print "\t*** SOAs are different!\n" if( $soa_diff ); print "$rr_count SOA RRs checked.\n"; } sub check_ptr { my( $domain, $class, $nsl, $zone ) = @_; my $res = new Net::DNS::Resolver; my $ptr_rr; my $rr_count = 0; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); foreach $ptr_rr ( grep { $_->type eq 'PTR' } @$zone ) { my @types; $ptr_rr->print if( $opt_v ); assert( $class eq $ptr_rr->class ); assert( 'PTR' eq $ptr_rr->type ); print "\tchecking PTR rr '$ptr_rr' to PTR\n" if( $opt_v ); @types = types4name( $ptr_rr->ptrdname, $domain, $class, $nsl ); if( grep { $_ eq 'A' } @types ) { xcheck_ptr2a( $ptr_rr, $domain, $class, $nsl ); } else { warn "\t'", $ptr_rr->ptrdname, "' doesn't resolve to an A RR (RRs are '", join( ', ', @types ), "')\n"; } ++$rr_count; } print "$rr_count PTR RRs checked.\n"; } sub check_ns { my( $domain, $class, $nsl, $zone ) = @_; my $res = new Net::DNS::Resolver; my $ns_rr; my $rr_count = 0; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); # Go through the zone data and process # all NS RRs for the zone (delegation # NS RRs are ignored). Specifically, # check to see if the indicate name server # is a CNAME RR and the name resolves to an A # RR. Check to insure the address resolved # against the name has an associated PTR RR. # foreach $ns_rr ( grep { $_->type eq 'NS' } @$zone ) { my @types; $ns_rr->print if( $opt_v ); assert( $class eq $ns_rr->class ); assert( 'NS' eq $ns_rr->type ); next if( $ns_rr->name ne $domain ); printf( "rr nsdname: %s\n", $ns_rr->nsdname ) if $opt_v; @types = types4name( $ns_rr->nsdname, $domain, $class, $nsl ); if( grep { $_ eq 'A' } @types ) { xcheck_name( $ns_rr->nsdname, $domain, $class, $nsl ); } else { warn "\t'", $ns_rr->nsdname, "' doesn't resolve to an A RR (RRs are '", join( ', ', @types ), "')\n"; } ++$rr_count; } print "$rr_count NS RRs checked.\n"; } sub check_a { my( $domain, $class, $nsl, $zone ) = @_; my $res = new Net::DNS::Resolver; my $a_rr; my $rr_count = 0; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); # Go through the zone data and process # all A RRs. Specifically, check to insure # each A RR matches a PTR RR and the PTR RR # matches the A RR. # foreach $a_rr ( grep { $_->type eq 'A' } @$zone ) { $a_rr->print if( $opt_v ); assert( $class eq $a_rr->class ); assert( 'A' eq $a_rr->type ); print "\tchecking A RR '", $a_rr->address, "' to PTR\n" if( $opt_v ); xcheck_a2ptr( $a_rr, $domain, $class, $nsl ); ++$rr_count; } print "$rr_count A RRs checked.\n"; } sub check_mx { my( $domain, $class, $nsl, $zone ) = @_; my $res = new Net::DNS::Resolver; my $mx_rr; my $rr_count = 0; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); # Go through the zone data and process # all MX RRs. Specifically, check to insure # each MX RR resolves to an A RR and the # A RR has a matching PTR RR. # foreach $mx_rr ( grep { $_->type eq 'MX' } @$zone ) { $mx_rr->print if( $opt_v ); assert( $class eq $mx_rr->class ); assert( 'MX' eq $mx_rr->type ); print "\tchecking MX RR '", $mx_rr->exchange, "' to A\n" if( $opt_v ); xcheck_name( $mx_rr->exchange, $domain, $class, $nsl ); ++$rr_count; } print "$rr_count MX RRs checked.\n"; } sub check_cname { my( $domain, $class, $nsl, $zone ) = @_; my $res = new Net::DNS::Resolver; my $cname_rr; my $rr_count = 0; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); # Go through the zone data and process # all CNAME RRs. Specifically, check to insure # each CNAME RR resolves to an A RR and the # A RR has a matching PTR RR. # foreach $cname_rr ( grep { $_->type eq 'CNAME' } @$zone ) { my @types; $cname_rr->print if( $opt_v ); assert( $class eq $cname_rr->class ); assert( 'CNAME' eq $cname_rr->type ); print "\tchecking CNAME RR '", $cname_rr->cname, "' to A\n" if( $opt_v ); @types = types4name( $cname_rr->cname, $domain, $class, $nsl ); if( grep { $_ eq 'A' } @types ) { xcheck_name( $cname_rr->cname, $domain, $class, $nsl ); } else { warn "\t'", $cname_rr->cname, "' doesn't resolve to an A RR (RRs are '", join( ', ', @types ), "')\n"; } ++$rr_count; } print "$rr_count CNAME RRs checked.\n"; } sub check_w_equivs_and_exceptions { my ($left, $comp, $right) = @_; if (defined $exceptions{$left}) { foreach my $rval (@{$exceptions{$left}}) { $left = $right if ($rval eq $right); } } if ($opt_a){ $left =~ s/\.?$opt_a$//; $left =~ s/\.?$main_domain$//; $right =~ s/\.?$opt_a$//; $right =~ s/\.?$main_domain$//; } return (eval ("\"$left\" $comp \"$right\"") ); } sub xcheck_a2ptr { my( $a_rr, $domain, $class, $nsl ) = @_; my $res = new Net::DNS::Resolver; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); assert( $class eq $a_rr->class ); assert( 'A' eq $a_rr->type ); # Request a PTR RR against the A RR. # A missing PTR RR is an error. # my $ans = $res->query( $a_rr->address, 'PTR', $class ); if( defined( $ans )) { my $ptr_rr; foreach $ptr_rr ( $ans->answer ) { $ptr_rr->print if( $opt_v ); assert( $class eq $ptr_rr->class ); assert( 'PTR' eq $ptr_rr->type ); warn( "\t'", $a_rr->name, "' has address '", $a_rr->address, "' but PTR is '", $ptr_rr->ptrdname, "'\n" ) if( check_w_equivs_and_exceptions($a_rr->name, "ne", $ptr_rr->ptrdname) ); warn( "\t'", $a_rr->name, "' has address '", $a_rr->address, "' but PTR is '", ip_ptr2a_str( $ptr_rr->name ), "'\n" ) if( $a_rr->address ne ip_ptr2a_str( $ptr_rr->name )); } } else { warn( "\tNO PTR RR for '", $a_rr->name, "' at address '", $a_rr->address,"'\n" ); } } sub xcheck_ptr2a { my( $ptr_rr, $domain, $class, $nsl ) = @_; my $res = new Net::DNS::Resolver; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); assert( $class eq $ptr_rr->class ); assert( 'PTR' eq $ptr_rr->type ); # Request an A RR against the PTR RR. # A missing A RR is an error. # my $ans = $res->query( $ptr_rr->ptrdname, 'A', $class ); if( defined( $ans )) { my $a_rr; foreach $a_rr ( $ans->answer ) { $a_rr->print if( $opt_v ); assert( $class eq $a_rr->class ); assert( 'A' eq $a_rr->type ); warn( "\tPTR RR '", $ptr_rr->name, "' has name '", $ptr_rr->ptrdname, "' but A query returned '", $a_rr->name, "'\n" ) if( check_w_equivs_and_exceptions($ptr_rr->ptrdname, "ne", $a_rr->name) ); warn( "\tPTR RR '", $ptr_rr->name, "' has address '", ip_ptr2a_str( $ptr_rr->name ), "' but A query returned '", $a_rr->address, "'\n" ) if( ip_ptr2a_str( $ptr_rr->name ) ne $a_rr->address ); } } else { warn( "\tNO A RR for '", $ptr_rr->ptrdname, "' at address '", ip_ptr2a_str( $ptr_rr->address ), "'\n" ); } } sub xcheck_name { my( $name, $domain, $class, $nsl ) = @_; my $res = new Net::DNS::Resolver; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); # Get the A RR for the name. # my $ans = $res->query( $name, 'A', $class ); if( defined( $ans )) { # There is one or more A RRs. # For each A RR do a reverse look-up # and verify the PTR matches the A. # my $a_rr; foreach $a_rr ( $ans->answer ) { $a_rr->print if( $opt_v ); assert( $class eq $a_rr->class ); assert( 'A' eq $a_rr->type ); warn( "\tQuery for '$name' returned A RR name '", $a_rr->name, "'\n" ) if( check_w_equivs_and_exceptions($name, "ne", $a_rr->name) ); xcheck_a2ptr( $a_rr, $domain, $class, $nsl ); } } else { warn( "\t", $name, " has no A RR\n" ); } } sub types4name { my( $name, $domain, $class, $nsl ) = @_; my $res = new Net::DNS::Resolver; my @rr_types; $res->defnames( 0 ); $res->retry( 2 ); $res->nameservers( @$nsl ); # Get the RRs for the name. # my $ans = $res->query( $name, 'ANY', $class ); if( defined( $ans )) { my $any_rr; foreach $any_rr ( $ans->answer ) { $any_rr->print if( $opt_v ); assert( $class eq $any_rr->class ); push @rr_types, ( $any_rr->type ); } } else { warn( "\t'", $name, "' doesn't resolve.\n" ); } # If there were no RRs for the name then # return the RR types of ??? # push @rr_types, ( '???' ) if( ! @rr_types ); return @rr_types; } sub ip_ptr2a_str { my( $d, $c, $b, $a ) = ip_parts( $_[0]); return "$a.$b.$c.$d"; } sub ip_parts { my $ip = $_[0]; assert( $ip ne '' ); if( $ip =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/oi ) { return ( $1, $2, $3, $4 ); } else { warn "Unable to parse '$ip'\n"; } assert( 0 ); } Net-DNS-1.07/lib/0000755000175000017500000000000013031240175012717 5ustar willemwillemNet-DNS-1.07/lib/Net/0000755000175000017500000000000013031240175013445 5ustar willemwillemNet-DNS-1.07/lib/Net/DNS/0000755000175000017500000000000013031240175014071 5ustar willemwillemNet-DNS-1.07/lib/Net/DNS/RR/0000755000175000017500000000000013031240175014414 5ustar willemwillemNet-DNS-1.07/lib/Net/DNS/RR/URI.pm0000644000175000017500000001027113031240164015410 0ustar willemwillempackage Net::DNS::RR::URI; # # $Id: URI.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::URI - DNS URI resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{qw(priority weight)} = unpack( "\@$offset n2", $$data ); $offset += 4; $self->{target} = decode Net::DNS::Text( $data, $offset, $limit - $offset ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $target = $self->{target} || return ''; pack 'n2 a*', @{$self}{qw(priority weight)}, $target->raw; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target} || return ''; my @rdata = ( $self->priority, $self->weight, $target->string ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; map $self->$_(shift), qw(priority weight target); } sub priority { my $self = shift; $self->{priority} = 0 + shift if scalar @_; $self->{priority} || 0; } sub weight { my $self = shift; $self->{weight} = 0 + shift if scalar @_; $self->{weight} || 0; } sub target { my $self = shift; $self->{target} = new Net::DNS::Text(shift) if scalar @_; $self->{target}->value if $self->{target}; } # order RRs by numerically increasing priority, decreasing weight my $function = sub { my ( $a, $b ) = ( $Net::DNS::a, $Net::DNS::b ); $a->{priority} <=> $b->{priority} || $b->{weight} <=> $a->{weight}; }; __PACKAGE__->set_rrsort_func( 'priority', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name URI priority weight target'); =head1 DESCRIPTION Class for DNS Service (URI) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 priority $priority = $rr->priority; $rr->priority( $priority ); The priority of the target URI in this RR. The range of this number is 0-65535. A client MUST attempt to contact the URI with the lowest-numbered priority it can reach; weighted selection being used to distribute load across targets with equal priority. =head2 weight $weight = $rr->weight; $rr->weight( $weight ); A server selection mechanism. The weight field specifies a relative weight for entries with the same priority. Larger weights SHOULD be given a proportionately higher probability of being selected. The range of this number is 0-65535. =head2 target $target = $rr->target; $rr->target( $target ); The URI of the target. Resolution of the URI is according to the definitions for the Scheme of the URI. =head1 COPYRIGHT Copyright (c)2015 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC7553 =cut Net-DNS-1.07/lib/Net/DNS/RR/NAPTR.pm0000644000175000017500000001341213031240164015635 0ustar willemwillempackage Net::DNS::RR::NAPTR; # # $Id: NAPTR.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NAPTR - DNS NAPTR resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; @{$self}{qw(order preference)} = unpack "\@$offset n2", $$data; ( $self->{flags}, $offset ) = decode Net::DNS::Text( $data, $offset + 4 ); ( $self->{service}, $offset ) = decode Net::DNS::Text( $data, $offset ); ( $self->{regexp}, $offset ) = decode Net::DNS::Text( $data, $offset ); $self->{replacement} = decode Net::DNS::DomainName2535( $data, $offset, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; return '' unless defined $self->{replacement}; my $rdata = pack 'n2', @{$self}{qw(order preference)}; $rdata .= $self->{flags}->encode; $rdata .= $self->{service}->encode; $rdata .= $self->{regexp}->encode; $rdata .= $self->{replacement}->encode( $offset + length($rdata), @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{replacement}; my @order = @{$self}{qw(order preference)}; my @rdata = ( @order, map $_->string, @{$self}{qw(flags service regexp replacement)} ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(order preference flags service regexp replacement)) { $self->$_(shift) } } sub order { my $self = shift; $self->{order} = 0 + shift if scalar @_; $self->{order} || 0; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub flags { my $self = shift; $self->{flags} = new Net::DNS::Text(shift) if scalar @_; $self->{flags}->value if $self->{flags}; } sub service { my $self = shift; $self->{service} = new Net::DNS::Text(shift) if scalar @_; $self->{service}->value if $self->{service}; } sub regexp { my $self = shift; $self->{regexp} = new Net::DNS::Text(shift) if scalar @_; $self->{regexp}->value if $self->{regexp}; } sub replacement { my $self = shift; $self->{replacement} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{replacement}->name if $self->{replacement}; } my $function = sub { my ( $a, $b ) = ( $Net::DNS::a, $Net::DNS::b ); $a->{order} <=> $b->{order} || $a->{preference} <=> $b->{preference}; }; __PACKAGE__->set_rrsort_func( 'order', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name NAPTR order preference flags service regexp replacement'); =head1 DESCRIPTION DNS Naming Authority Pointer (NAPTR) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 order $order = $rr->order; $rr->order( $order ); A 16-bit unsigned integer specifying the order in which the NAPTR records must be processed to ensure the correct ordering of rules. Low numbers are processed before high numbers. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16-bit unsigned integer that specifies the order in which NAPTR records with equal "order" values should be processed, low numbers being processed before high numbers. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); A string containing flags to control aspects of the rewriting and interpretation of the fields in the record. Flags are single characters from the set [A-Z0-9]. =head2 service $service = $rr->service; $rr->service( $service ); Specifies the service(s) available down this rewrite path. It may also specify the protocol used to communicate with the service. =head2 regexp $regexp = $rr->regexp; $rr->regexp; A string containing a substitution expression that is applied to the original string held by the client in order to construct the next domain name to lookup. =head2 replacement $replacement = $rr->replacement; $rr->replacement( $replacement ); The next NAME to query for NAPTR, SRV, or address records depending on the value of the flags field. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2005 Olaf Kolkman, NLnet Labs. Based on code contributed by Ryan Moats. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC2915, RFC2168, RFC3403 =cut Net-DNS-1.07/lib/Net/DNS/RR/CERT.pm0000644000175000017500000001441713031240164015514 0ustar willemwillempackage Net::DNS::RR::CERT; # # $Id: CERT.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CERT - DNS CERT resource record =cut use integer; use Carp; use MIME::Base64; my %certtype = ( PKIX => 1, # X.509 as per PKIX SPKI => 2, # SPKI certificate PGP => 3, # OpenPGP packet IPKIX => 4, # The URL of an X.509 data object ISPKI => 5, # The URL of an SPKI certificate IPGP => 6, # The fingerprint and URL of an OpenPGP packet ACPKIX => 7, # Attribute Certificate IACPKIX => 8, # The URL of an Attribute Certificate URI => 253, # URI private OID => 254, # OID private ); # # source: http://www.iana.org/assignments/dns-sec-alg-numbers # { my @algbyname = ( ## Reserved => 0, # [RFC4034][RFC4398] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; my $map = sub { my $arg = shift; return $arg if $arg =~ /^\d/; $arg =~ s/[^A-Za-z0-9]//g; # strip non-alphanumerics uc($arg); }; my @pairedval = sort ( 1 .. 254, 1 .. 254 ); # also accept number my %algbyname = map &$map($_), @algbyname, @pairedval; sub _algbyname { my $name = shift; my $key = uc $name; # synthetic key $key =~ s/[^A-Z0-9]//g; # strip non-alphanumerics $algbyname{$key} || croak "unknown algorithm $name"; } sub _algbyval { my $value = shift; $algbyval{$value} || return $value; } } sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(certtype keytag algorithm)} = unpack "\@$offset n2 C", $$data; $self->{certbin} = substr $$data, $offset + 5, $self->{rdlength} - 5; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{certbin}; pack "n2 C a*", $self->certtype, $self->keytag, $self->algorithm, $self->{certbin}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{certbin}; my @base64 = split /\s+/, encode_base64( $self->{certbin} ); my @rdata = ( $self->certtype, $self->keytag, $self->algorithm, @base64 ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->certtype(shift); $self->keytag(shift); $self->algorithm(shift); $self->cert(@_); } sub certtype { my $self = shift; return $self->{certtype} unless scalar @_; my $certtype = shift || 0; return $self->{certtype} = $certtype unless $certtype =~ /\D/; my $typenum = $certtype{$certtype}; $typenum || croak "unknown certtype $certtype"; $self->{certtype} = $typenum; } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; $self->{keytag} || 0; } sub algorithm { my ( $self, $arg ) = @_; return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = $arg ? _algbyname($arg) : 0; } sub certificate { &certbin; } sub certbin { my $self = shift; $self->{certbin} = shift if scalar @_; $self->{certbin} || ""; } sub cert { my $self = shift; $self->certbin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->certbin(), "" ) if defined wantarray; } sub format { &certtype; } # uncoverable pod sub tag { &keytag; } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN CERT certtype keytag algorithm cert'); =head1 DESCRIPTION Class for DNS Certificate (CERT) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 certtype $certtype = $rr->certtype; Returns the certtype code for the certificate (in numeric form). =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); Returns the key tag for the public key in the certificate =head2 algorithm $algorithm = $rr->algorithm; Returns the algorithm used by the certificate (in numeric form). =head2 certificate =head2 certbin $certbin = $rr->certbin; $rr->certbin( $certbin ); Binary representation of the certificate. =head2 cert $cert = $rr->cert; $rr->cert( $cert ); Base64 representation of the certificate. =head1 COPYRIGHT Copyright (c)2002 VeriSign, Mike Schiraldi All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC4398 =cut Net-DNS-1.07/lib/Net/DNS/RR/RP.pm0000644000175000017500000000756513031240164015306 0ustar willemwillempackage Net::DNS::RR::RP; # # $Id: RP.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::RP - DNS RP resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Mailbox; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; ( $self->{mbox}, $offset ) = decode Net::DNS::Mailbox2535( $data, $offset, @opaque ); $self->{txtdname} = decode Net::DNS::DomainName2535( $data, $offset, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $txtdname = $self->{txtdname} || return ''; my $rdata = $self->{mbox}->encode( $offset, @opaque ); $rdata .= $txtdname->encode( $offset + length($rdata), @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $txtdname = $self->{txtdname} || return ''; my @rdata = ( $self->{mbox}->string, $txtdname->string ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->mbox(shift); $self->txtdname(shift); } sub mbox { my $self = shift; $self->{mbox} = new Net::DNS::Mailbox2535(shift) if scalar @_; $self->{mbox}->address if $self->{mbox}; } sub txtdname { my $self = shift; $self->{txtdname} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{txtdname}->name if $self->{txtdname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name RP mbox txtdname'); =head1 DESCRIPTION Class for DNS Responsible Person (RP) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 mbox $mbox = $rr->mbox; $rr->mbox( $mbox ); A domain name which specifies the mailbox for the person responsible for this domain. The format in master files uses the DNS encoding convention for mailboxes, identical to that used for the RNAME mailbox field in the SOA RR. The root domain name (just ".") may be specified to indicate that no mailbox is available. =head2 txtdname $txtdname = $rr->txtdname; $rr->txtdname( $txtdname ); A domain name identifying TXT RRs. A subsequent query can be performed to retrieve the associated TXT records. This provides a level of indirection so that the entity can be referred to from multiple places in the DNS. The root domain name (just ".") may be specified to indicate that there is no associated TXT RR. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1183 Section 2.2 =cut Net-DNS-1.07/lib/Net/DNS/RR/CNAME.pm0000644000175000017500000000564213031240164015602 0ustar willemwillempackage Net::DNS::RR::CNAME; # # $Id: CNAME.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CNAME - DNS CNAME resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{cname} = decode Net::DNS::DomainName1035(@_); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $cname = $self->{cname} || return ''; $cname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $cname = $self->{cname} || return ''; $cname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->cname(shift); } sub cname { my $self = shift; $self->{cname} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{cname}->name if $self->{cname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name CNAME cname'); $rr = new Net::DNS::RR( name => 'alias.example.com', type => 'CNAME', cname => 'example.com', ); =head1 DESCRIPTION Class for DNS Canonical Name (CNAME) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 cname $cname = $rr->cname; $rr->cname( $cname ); A domain name which specifies the canonical or primary name for the owner. The owner name is an alias. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2002-2003 Chris Reinhardt. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.1 =cut Net-DNS-1.07/lib/Net/DNS/RR/MB.pm0000644000175000017500000000535513031240164015256 0ustar willemwillempackage Net::DNS::RR::MB; # # $Id: MB.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MB - DNS MB resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{madname} = decode Net::DNS::DomainName1035(@_); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $madname = $self->{madname} || return ''; $madname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $madname = $self->{madname} || return ''; $madname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->madname(shift); } sub madname { my $self = shift; $self->{madname} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{madname}->name if $self->{madname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name MB madname'); =head1 DESCRIPTION Class for DNS Mailbox (MB) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 madname $madname = $rr->madname; $rr->madname( $madname ); A domain name which specifies a host which has the specified mailbox. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.3 =cut Net-DNS-1.07/lib/Net/DNS/RR/CAA.pm0000644000175000017500000001016113031240164015333 0ustar willemwillempackage Net::DNS::RR::CAA; # # $Id: CAA.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CAA - DNS CAA resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; $self->{flags} = unpack "\@$offset C", $$data; ( $self->{tag}, $offset ) = decode Net::DNS::Text( $data, $offset + 1 ); $self->{value} = decode Net::DNS::Text( $data, $offset, $limit - $offset ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $tag = $self->{tag} || return ''; pack 'C a* a*', $self->flags, $tag->encode, $self->{value}->raw; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $tag = $self->{tag} || return ''; my @rdata = ( $self->flags, $tag->string, $self->{value}->string ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->flags(shift); $self->tag(shift); $self->value(shift); } sub _defaults { ## specify RR attribute default values my $self = shift; $self->flags(0); } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; $self->{flags} || 0; } sub critical { my $bit = 0x0080; for ( shift->{flags} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub tag { my $self = shift; $self->{tag} = new Net::DNS::Text(shift) if scalar @_; $self->{tag}->value if $self->{tag}; } sub value { my $self = shift; $self->{value} = new Net::DNS::Text(shift) if scalar @_; $self->{value}->value if $self->{value}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN CAA flags tag value'); =head1 DESCRIPTION Class for Certification Authority Authorization (CAA) DNS resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); Unsigned 8-bit number representing Boolean flags. =over 4 =item critical $rr->critical(1); if ( $rr->critical ) { ... } Issuer critical flag. =back =head2 tag $tag = $rr->tag; $rr->tag( $tag ); The property identifier, a sequence of ASCII characters. Tag values may contain ASCII characters a-z, A-Z, and 0-9. Tag values should not contain any other characters. Matching of tag values is not case sensitive. =head2 value $value = $rr->value; $rr->value( $value ); A sequence of octets representing the property value. Property values are encoded as binary values and may employ sub-formats. =head1 COPYRIGHT Copyright (c)2013,2015 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6844 =cut Net-DNS-1.07/lib/Net/DNS/RR/AFSDB.pm0000644000175000017500000000655413031240164015601 0ustar willemwillempackage Net::DNS::RR::AFSDB; # # $Id: AFSDB.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::AFSDB - DNS AFSDB resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{subtype} = unpack "\@$offset n", $$data; $self->{hostname} = decode Net::DNS::DomainName2535( $data, $offset + 2, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $hostname = $self->{hostname} || return ''; pack 'n a*', $self->subtype, $hostname->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $hostname = $self->{hostname} || return ''; join ' ', $self->subtype, $hostname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->subtype(shift); $self->hostname(shift); } sub subtype { my $self = shift; $self->{subtype} = 0 + shift if scalar @_; $self->{subtype} || 0; } sub hostname { my $self = shift; $self->{hostname} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{hostname}->name if $self->{hostname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name AFSDB subtype hostname'); =head1 DESCRIPTION Class for DNS AFS Data Base (AFSDB) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 subtype $subtype = $rr->subtype; $rr->subtype( $subtype ); A 16 bit integer which indicates the service offered by the listed host. =head2 hostname $hostname = $rr->hostname; $rr->hostname( $hostname ); The hostname field is a domain name of a host that has a server for the cell named by the owner name of the RR. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1183, RFC5864 =cut Net-DNS-1.07/lib/Net/DNS/RR/TXT.pm0000644000175000017500000000736613031240164015443 0ustar willemwillempackage Net::DNS::RR::TXT; # # $Id: TXT.pm 1520 2016-12-07 11:35:02Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1520 $)[1]; use strict; use base qw(Net::DNS::RR); =encoding utf8 =head1 NAME Net::DNS::RR::TXT - DNS TXT resource record =cut use integer; use Carp; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; my $text; my $txtdata = $self->{txtdata} = []; while ( $offset < $limit ) { ( $text, $offset ) = decode Net::DNS::Text( $data, $offset ); push @$txtdata, $text; } croak('corrupt TXT data') unless $offset == $limit; # more or less FUBAR } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $txtdata = $self->{txtdata} || []; join '', map $_->encode, @$txtdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $txtdata = $self->{txtdata} || []; my @txtdata = map $_->string, @$txtdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->{txtdata} = [map Net::DNS::Text->new($_), @_]; } sub txtdata { my $self = shift; $self->{txtdata} = [map Net::DNS::Text->new($_), @_] if scalar @_; my $txtdata = $self->{txtdata} || []; return ( map $_->value, @$txtdata ) if wantarray; join ' ', map $_->value, @$txtdata if defined wantarray; } sub char_str_list { return (&txtdata); } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR( 'name TXT txtdata ...' ); $rr = new Net::DNS::RR( name => 'name', type => 'TXT', txtdata => 'single text string' ); $rr = new Net::DNS::RR( name => 'name', type => 'TXT', txtdata => [ 'multiple', 'strings', ... ] ); use utf8; $rr = new Net::DNS::RR( 'jp TXT å¤æ± ã‚„　蛙飛込む　水ã®éŸ³' ); =head1 DESCRIPTION Class for DNS Text (TXT) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 txtdata $string = $rr->txtdata; @list = $rr->txtdata; $rr->txtdata( @list ); When invoked in scalar context, txtdata() returns a concatenation of the descriptive text elements each separated by a single space character. In a list context, txtdata() returns a list of the text elements. =head1 COPYRIGHT Copyright (c)2011 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.14, RFC3629 =cut Net-DNS-1.07/lib/Net/DNS/RR/AAAA.pm0000644000175000017500000001000113031240164015423 0ustar willemwillempackage Net::DNS::RR::AAAA; # # $Id: AAAA.pm 1491 2016-06-22 07:47:21Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1491 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::AAAA - DNS AAAA resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a16", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{address}; pack 'a16', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{address}; $self->address_short; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); } sub address_long { my $addr = pack 'a*@16', grep defined, shift->{address}; sprintf '%x:%x:%x:%x:%x:%x:%x:%x', unpack 'n8', $addr; } sub address_short { my $addr = pack 'a*@16', grep defined, shift->{address}; for ( sprintf ':%x:%x:%x:%x:%x:%x:%x:%x:', unpack 'n8', $addr ) { s/(:0[:0]+:)(?!.+:0\1)/::/; # squash longest zero sequence s/^:// unless /^::/; # prune LH : s/:$// unless /::$/; # prune RH : return $_; } } sub address { my $self = shift; return address_long($self) unless scalar @_; my $addr = shift; my @parse = split /:/, "0$addr"; if ( (@parse)[$#parse] =~ /\./ ) { # embedded IPv4 my @ip4 = split /\./, pop(@parse); my $rhs = pop(@ip4); my @ip6 = map { /./ ? hex($_) : (0) x ( 7 - @parse ) } @parse; return $self->{address} = pack 'n6 C4', @ip6, @ip4, (0) x ( 3 - @ip4 ), $rhs; } # Note: pack() masks overlarge values, mostly without warning. my @expand = map { /./ ? hex($_) : (0) x ( 9 - @parse ) } @parse; $self->{address} = pack 'n8', @expand; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN AAAA address'); $rr = new Net::DNS::RR( name => 'example.com', type => 'AAAA', address => '2001:DB8::8:800:200C:417A' ); =head1 DESCRIPTION Class for DNS IPv6 Address (AAAA) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address $IPv6_address = $rr->address; Returns the text representation of the IPv6 address. =head2 address_long $IPv6_address = $rr->address_long; Returns the text representation specified in RFC3513, 2.2(1). =head2 address_short $IPv6_address = $rr->address_short; Returns the textual form of address recommended by RFC5952. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2003 Chris Reinhardt. Portions Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC3596, RFC3513, RFC5952 =cut Net-DNS-1.07/lib/Net/DNS/RR/SRV.pm0000644000175000017500000001054213031240164015424 0ustar willemwillempackage Net::DNS::RR::SRV; # # $Id: SRV.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SRV - DNS SRV resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; @{$self}{qw(priority weight port)} = unpack( "\@$offset n3", $$data ); $self->{target} = decode Net::DNS::DomainName2535( $data, $offset + 6, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $target = $self->{target} || return ''; my @nums = ( $self->priority, $self->weight, $self->port ); pack 'n3 a*', @nums, $target->encode( $offset + 6, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target} || return ''; my @rdata = ( $self->priority, $self->weight, $self->port, $target->string ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach my $attr (qw(priority weight port target)) { $self->$attr(shift); } } sub priority { my $self = shift; $self->{priority} = 0 + shift if scalar @_; $self->{priority} || 0; } sub weight { my $self = shift; $self->{weight} = 0 + shift if scalar @_; $self->{weight} || 0; } sub port { my $self = shift; $self->{port} = 0 + shift if scalar @_; $self->{port} || 0; } sub target { my $self = shift; $self->{target} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{target}->name if $self->{target}; } # order RRs by numerically increasing priority, decreasing weight my $function = sub { my ( $a, $b ) = ( $Net::DNS::a, $Net::DNS::b ); $a->{priority} <=> $b->{priority} || $b->{weight} <=> $a->{weight}; }; __PACKAGE__->set_rrsort_func( 'priority', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name SRV priority weight port target'); =head1 DESCRIPTION Class for DNS Service (SRV) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 priority $priority = $rr->priority; $rr->priority( $priority ); Returns the priority for this target host. =head2 weight $weight = $rr->weight; $rr->weight( $weight ); Returns the weight for this target host. =head2 port $port = $rr->port; $rr->port( $port ); Returns the port number for the service on this target host. =head2 target $target = $rr->target; $rr->target( $target ); Returns the domain name of the target host. =head1 Sorting of SRV Records By default, rrsort() returns the SRV records sorted from lowest to highest priority and for equal priorities from highest to lowest weight. Note: This is NOT the order in which connections should be attempted. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC2782 =cut Net-DNS-1.07/lib/Net/DNS/RR/HINFO.pm0000644000175000017500000000610113031240164015611 0ustar willemwillempackage Net::DNS::RR::HINFO; # # $Id: HINFO.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::HINFO - DNS HINFO resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; ( $self->{cpu}, $offset ) = decode Net::DNS::Text( $data, $offset ); ( $self->{os}, $offset ) = decode Net::DNS::Text( $data, $offset ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{os}; join '', $self->{cpu}->encode, $self->{os}->encode; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{os}; join ' ', $self->{cpu}->string, $self->{os}->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->cpu(shift); $self->os(@_); } sub cpu { my $self = shift; $self->{cpu} = new Net::DNS::Text(shift) if scalar @_; $self->{cpu}->value if $self->{cpu}; } sub os { my $self = shift; $self->{os} = new Net::DNS::Text(shift) if scalar @_; $self->{os}->value if $self->{os}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name HINFO cpu os'); =head1 DESCRIPTION Class for DNS Hardware Information (HINFO) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 cpu $cpu = $rr->cpu; $rr->cpu( $cpu ); Returns the CPU type for this RR. =head2 os $os = $rr->os; $rr->os( $os ); Returns the operating system type for this RR. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.2 =cut Net-DNS-1.07/lib/Net/DNS/RR/APL.pm0000644000175000017500000001547713031240164015402 0ustar willemwillempackage Net::DNS::RR::APL; # # $Id: APL.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::APL - DNS APL resource record =cut use integer; use Carp; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; my $aplist = $self->{aplist} = []; while ( $offset < $limit ) { my $xlen = unpack "\@$offset x3 C", $$data; my $size = ( $xlen & 0x7F ); my $item = bless {}, 'Net::DNS::RR::APL::Item'; $item->negate(1) if $xlen & 0x80; @{$item}{qw(family prefix address)} = unpack "\@$offset n C x a$size", $$data; $offset += $size + 4; push @$aplist, $item; } croak('corrupt APL data') unless $offset == $limit; # more or less FUBAR } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my @rdata; my $aplist = $self->{aplist} || []; foreach (@$aplist) { my $address = $_->{address}; my $xlength = $_->negate | length($address); push @rdata, pack 'n C2 a*', @{$_}{qw(family prefix)}, $xlength, $address; } join '', @rdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $aplist = $self->{aplist} || []; my @rdata = map $_->string, @$aplist; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->aplist(@_); } sub aplist { my $self = shift; while ( scalar @_ ) { # parse apitem strings last unless $_[0] =~ m#^(!?)(\d+):(.+)/(\d+)$#; my $n = $1 ? 1 : 0; my $f = $2; my ( $x, $a, $p ) = split m#^[^:]+:|/#, shift; $self->aplist( negate => $n, family => $f, address => $a, prefix => $p ); } my $aplist = $self->{aplist} ||= []; if ( my %argval = @_ ) { # parse attribute=value list my $item = bless {}, 'Net::DNS::RR::APL::Item'; while ( my ( $attribute, $value ) = each %argval ) { $item->$attribute($value) unless $attribute eq 'address'; } $item->address( $argval{address} ); # address must be last push @$aplist, $item; } my @ap = @$aplist; return wantarray ? @ap : join ' ', map $_->string, @ap if defined wantarray; } ######################################## package Net::DNS::RR::APL::Item; sub negate { my $bit = 0x80; for ( shift->{negate} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub family { my $self = shift; $self->{family} = 0 + shift if scalar @_; $self->{family} || 0; } sub prefix { my $self = shift; $self->{prefix} = 0 + shift if scalar @_; $self->{prefix} || 0; } { use Net::DNS::RR::A; use Net::DNS::RR::AAAA; sub _address_1 { my $self = shift; my $A = bless {%$self}, 'Net::DNS::RR::A'; return $A->address unless scalar @_; my $alength = ( $self->prefix + 7 ) >> 3; # mask non-prefix bits, suppress nulls my @address = unpack "C$alength", $A->address(shift); my $bitmask = 0xFF << ( 8 - $self->prefix & 7 ); push @address, ( $bitmask & pop(@address) ) if $alength; for ( reverse @address ) { last if $_; pop @address } $self->{address} = pack 'C*', @address; } sub _address_2 { my $self = shift; my $AAAA = bless {%$self}, 'Net::DNS::RR::AAAA'; return $AAAA->address_long unless scalar @_; my $alength = ( $self->prefix + 7 ) >> 3; # mask non-prefix bits, suppress nulls my @address = unpack "C$alength", $AAAA->address(shift); my $bitmask = 0xFF << ( 8 - $self->prefix & 7 ); push @address, ( $bitmask & pop(@address) ) if $alength; for ( reverse @address ) { last if $_; pop @address } $self->{address} = pack 'C*', @address; } } sub address { for ( $_[0]->family ) { return &_address_1 if /1/; return &_address_2 if /2/; die 'unknown address family'; } } sub string { my $self = shift; my $not = $self->negate ? '!' : ''; my ( $family, $address, $prefix ) = ( $self->family, $self->address, $self->prefix ); return "$not$family:$address/$prefix"; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN APL aplist'); =head1 DESCRIPTION DNS Address Prefix List (APL) record =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 aplist @aplist = $rr->aplist; @aplist = $rr->aplist( '1:192.168.32.0/21', '!1:192.168.38.0/28' ); @aplist = $rr->aplist( '1:224.0.0.0/4', '2:FF00:0:0:0:0:0:0:0/8' ); @aplist = $rr->aplist( negate => 1, family => 1, address => '192.168.38.0', prefix => 28, ); Ordered, possibly empty, list of address prefix items. Additional items, if present, are appended to the existing list with neither prefix aggregation nor reordering. =head2 Net::DNS::RR::APL::Item Each element of the prefix list is a Net::DNS::RR::APL::Item object which is inextricably bound to the APL record which created it. =head2 negate $rr->negate(1); if ( $rr->negate ) { ... } Boolean attribute indicating the prefix to be an address range exclusion. =head2 family $family = $rr->family; $rr->family( $family ); Address family discriminant. =head2 prefix $prefix = $rr->prefix; $rr->prefix( $prefix ); Number of bits comprising the address prefix. =head2 address $address = $object->address; Address portion of the prefix list item. =head2 string $string = $object->string; Returns the prefix list item in the form required in zone files. =head1 COPYRIGHT Copyright (c)2008 Olaf Kolkman, NLnet Labs. Portions Copyright (c)2011 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC3123 =cut Net-DNS-1.07/lib/Net/DNS/RR/MG.pm0000644000175000017500000000542313031240164015257 0ustar willemwillempackage Net::DNS::RR::MG; # # $Id: MG.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MG - DNS MG resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{mgmname} = decode Net::DNS::DomainName1035(@_); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $mgmname = $self->{mgmname} || return ''; $mgmname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $mgmname = $self->{mgmname} || return ''; $mgmname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->mgmname(shift); } sub mgmname { my $self = shift; $self->{mgmname} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{mgmname}->name if $self->{mgmname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name MG mgmname'); =head1 DESCRIPTION Class for DNS Mail Group (MG) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 mgmname $mgmname = $rr->mgmname; $rr->mgmname( $mgmname ); A domain name which specifies a mailbox which is a member of the mail group specified by the owner name. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.6 =cut Net-DNS-1.07/lib/Net/DNS/RR/CDNSKEY.pm0000644000175000017500000000410313031240164016046 0ustar willemwillempackage Net::DNS::RR::CDNSKEY; # # $Id: CDNSKEY.pm 1339 2015-04-16 13:01:17Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1339 $)[1]; use strict; use base qw(Net::DNS::RR::DNSKEY); =head1 NAME Net::DNS::RR::CDNSKEY - DNS CDNSKEY resource record =cut 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name CDNSKEY flags protocol algorithm publickey'); =head1 DESCRIPTION DNS Child DNSKEY resource record This is a clone of the DNSKEY record and inherits all properties of the Net::DNS::RR::DNSKEY class. Please see the L perl documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2014 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC7344 =cut Net-DNS-1.07/lib/Net/DNS/RR/NS.pm0000644000175000017500000000557113031240164015300 0ustar willemwillempackage Net::DNS::RR::NS; # # $Id: NS.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NS - DNS NS resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{nsdname} = decode Net::DNS::DomainName1035(@_); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $nsdname = $self->{nsdname} || return ''; $nsdname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $nsdname = $self->{nsdname} || return ''; $nsdname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->nsdname(shift); } sub nsdname { my $self = shift; $self->{nsdname} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{nsdname}->name if $self->{nsdname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name NS nsdname'); $rr = new Net::DNS::RR( name => 'example.com', type => 'NS', nsdname => 'ns.example.com', ); =head1 DESCRIPTION Class for DNS Name Server (NS) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 nsdname $nsdname = $rr->nsdname; $rr->nsdname( $nsdname ); A domain name which specifies a host which should be authoritative for the specified class and domain. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.11 =cut Net-DNS-1.07/lib/Net/DNS/RR/CSYNC.pm0000644000175000017500000001100213031240164015621 0ustar willemwillempackage Net::DNS::RR::CSYNC; # # $Id: CSYNC.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CSYNC - DNS CSYNC resource record =cut use integer; use Net::DNS::Parameters; use Net::DNS::RR::NSEC; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{qw(soaserial flags)} = unpack "\@$offset Nn", $$data; $offset += 6; $self->{typebm} = substr $$data, $offset, $limit - $offset; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{typebm}; pack 'N n a*', $self->soaserial, $self->flags, $self->{typebm}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{typebm}; my @rdata = ( $self->soaserial, $self->flags, $self->typelist ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->soaserial(shift); $self->flags(shift); $self->typelist(@_); } sub soaserial { my $self = shift; $self->{soaserial} = 0 + shift if scalar @_; $self->{soaserial} || 0; } sub SOAserial {&soaserial} sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; $self->{flags} || 0; } sub immediate { my $bit = 0x0001; for ( shift->{flags} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub soaminimum { my $bit = 0x0002; for ( shift->{flags} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub typelist { &Net::DNS::RR::NSEC::typelist; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name CSYNC SOAserial flags typelist'); =head1 DESCRIPTION Class for DNSSEC CSYNC resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 SOAserial =head2 soaserial $soaserial = $rr->soaserial; $rr->soaserial( $soaserial ); The SOA Serial field contains a copy of the 32-bit SOA serial number from the child zone. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); The flags field contains 16 bits of boolean flags that define operations which affect the processing of the CSYNC record. =over 4 =item immediate $rr->immediate(1); if ( $rr->immediate ) { ... } If not set, a parental agent must not process the CSYNC record until the zone administrator approves the operation through an out-of-band mechanism. =back =over 4 =item soaminimum $rr->soaminimum(1); if ( $rr->soaminimum ) { ... } If set, a parental agent querying child authoritative servers must not act on data from zones advertising an SOA serial number less than the SOAserial value. =back =head2 typelist @typelist = $rr->typelist; $typelist = $rr->typelist; The type list indicates the record types to be processed by the parental agent. When called in scalar context, the list is interpolated into a string. =head1 COPYRIGHT Copyright (c)2015 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC7477 =cut Net-DNS-1.07/lib/Net/DNS/RR/PTR.pm0000644000175000017500000000540613031240164015422 0ustar willemwillempackage Net::DNS::RR::PTR; # # $Id: PTR.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::PTR - DNS PTR resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{ptrdname} = decode Net::DNS::DomainName1035(@_); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $ptrdname = $self->{ptrdname} || return ''; $ptrdname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $ptrdname = $self->{ptrdname} || return ''; $ptrdname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->ptrdname(shift); } sub ptrdname { my $self = shift; $self->{ptrdname} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{ptrdname}->name if $self->{ptrdname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name PTR ptrdname'); =head1 DESCRIPTION Class for DNS Pointer (PTR) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 ptrdname $ptrdname = $rr->ptrdname; $rr->ptrdname( $ptrdname ); A domain name which points to some location in the domain name space. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.12 =cut Net-DNS-1.07/lib/Net/DNS/RR/L64.pm0000644000175000017500000000753213031240164015324 0ustar willemwillempackage Net::DNS::RR::L64; # # $Id: L64.pm 1408 2015-10-06 20:35:56Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1408 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::L64 - DNS L64 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(preference locator64)} = unpack "\@$offset n a8", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{locator64}; pack 'n a8', $self->{preference}, $self->{locator64}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{locator64}; join ' ', $self->preference, $self->locator64; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->locator64(shift); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub locator64 { my $self = shift; my $prfx = shift; $self->{locator64} = pack 'n4', map hex($_), split /:/, $prfx if defined $prfx; sprintf '%x:%x:%x:%x', unpack 'n4', $self->{locator64} if $self->{locator64}; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN L64 preference locator64'); $rr = new Net::DNS::RR( name => 'example.com', type => 'L64', preference => 10, locator64 => '2001:0DB8:1140:1000' ); =head1 DESCRIPTION Class for DNS 64-bit Locator (L64) resource records. The L64 resource record is used to hold 64-bit Locator values for ILNPv6-capable nodes. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this L64 record among other L64 records associated with this owner name. Lower values are preferred over higher values. =head2 locator64 $locator64 = $rr->locator64; The Locator64 field is an unsigned 64-bit integer in network byte order that has the same syntax and semantics as a 64-bit IPv6 routing prefix. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6742 =cut Net-DNS-1.07/lib/Net/DNS/RR/DNSKEY.pm0000644000175000017500000002144313031240164015751 0ustar willemwillempackage Net::DNS::RR::DNSKEY; # # $Id: DNSKEY.pm 1490 2016-06-22 07:46:20Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1490 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DNSKEY - DNS DNSKEY resource record =cut use integer; use Carp; use constant BASE64 => defined eval 'require MIME::Base64'; # # source: http://www.iana.org/assignments/dns-sec-alg-numbers # { my @algbyname = ( ## Reserved => 0, # [RFC4034][RFC4398] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; my $map = sub { my $arg = shift; return $arg if $arg =~ /^\d/; $arg =~ s/[^A-Za-z0-9]//g; # strip non-alphanumerics uc($arg); }; my @pairedval = sort ( 1 .. 254, 1 .. 254 ); # also accept number my %algbyname = map &$map($_), @algbyname, @pairedval; sub _algbyname { my $name = shift; my $key = uc $name; # synthetic key $key =~ s/[^A-Z0-9]//g; # strip non-alphanumerics $algbyname{$key} || croak "unknown algorithm $name"; } sub _algbyval { my $value = shift; $algbyval{$value} || return $value; } } sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $keylength = $self->{rdlength} - 4; @{$self}{qw(flags protocol algorithm keybin)} = unpack "\@$offset n C2 a$keylength", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{keybin}; return &Net::DNS::RR::_format_rdata($self) unless BASE64; pack 'n C2 a*', $self->flags, $self->protocol, $self->algorithm, $self->{keybin}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{keybin}; $self->_annotation( 'Key ID =', $self->keytag ); my @base64 = split /\s+/, MIME::Base64::encode( $self->{keybin} ); my @params = map $self->$_, qw(flags protocol algorithm); my @rdata = ( @params, @base64 ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(flags protocol algorithm)) { $self->$_(shift) } $self->key(@_); } sub _defaults { ## specify RR attribute default values my $self = shift; $self->algorithm(1); $self->flags(256); $self->protocol(3); } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; $self->{flags} || 0; } sub zone { my $bit = 0x0100; for ( shift->{flags} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub revoke { my $bit = 0x0080; for ( shift->{flags} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub sep { my $bit = 0x0001; for ( shift->{flags} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub protocol { my $self = shift; $self->{protocol} = 0 + shift if scalar @_; $self->{protocol} || 0; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _algbyname($arg); } sub key { my $self = shift; $self->keybin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->keybin(), "" ) if defined wantarray; } sub keybin { my $self = shift; $self->{keybin} = shift if scalar @_; $self->{keybin} || ""; } sub publickey { &key; } sub privatekeyname { my $self = shift; my $name = $self->signame; sprintf 'K%s+%03d+%05d.private', $name, $self->algorithm, $self->keytag; } sub signame { my $self = shift; my $name = lc $self->{owner}->fqdn; } sub keylength { my $self = shift; my $keybin = $self->keybin || return undef; local $_ = _algbyval( $self->{algorithm} ); if (/^RSA/) { # Modulus length, see RFC 3110 if ( my $exp_length = unpack 'C', $keybin ) { return ( length($keybin) - $exp_length - 1 ) << 3; } else { $exp_length = unpack 'x n', $keybin; return ( length($keybin) - $exp_length - 3 ) << 3; } } elsif (/^DSA/) { # Modulus length, see RFC 2536 my $T = unpack 'C', $keybin; return ( $T << 6 ) + 512; } length($keybin) << 2; ## ECDSA / ECC-GOST } sub keytag { my $self = shift; my $keybin = $self->keybin || return 0; # RFC4034 Appendix B.1: most significant 16 bits of least significant 24 bits return unpack 'n', substr $keybin, -3 if $self->{algorithm} == 1; # RFC4034 Appendix B my $od = length($keybin) & 1; my $rd = pack "n C2 a* x$od", @{$self}{qw(flags protocol algorithm)}, $keybin; my $ac = 0; $ac += $_ for unpack 'n*', $rd; $ac += ( $ac >> 16 ); return $ac & 0xFFFF; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name DNSKEY flags protocol algorithm publickey'); =head1 DESCRIPTION Class for DNSSEC Key (DNSKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); Unsigned 16-bit number representing Boolean flags. =over 4 =item zone $rr->zone(1); if ( $rr->zone ) { ... } Boolean Zone flag. =back =over 4 =item revoke $rr->revoke(1); if ( $rr->revoke ) { ... } Boolean Revoke flag. =back =over 4 =item sep $rr->sep(1); if ( $rr->sep ) { ... } Boolean Secure Entry Point flag. =back =head2 protocol $protocol = $rr->protocol; $rr->protocol( $protocol ); The 8-bit protocol number. This field MUST have value 3. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The 8-bit algorithm number describes the public key algorithm. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 publickey =head2 key $key = $rr->key; $rr->key( $key ); Base64 representation of the public key material. =head2 keybin $keybin = $rr->keybin; $rr->keybin( $keybin ); Opaque octet string representing the public key material. =head2 privatekeyname $privatekeyname = $rr->privatekeyname; Returns the name of the privatekey as it would be generated by the BIND dnssec-keygen program. The format of that name being: K++.private =head2 signame Returns the canonical signer name of the privatekey. =head2 keylength Returns the length (in bits) of the modulus calculated from the key text. =head2 keytag print "keytag = ", $rr->keytag, "\n"; Returns the 16-bit numerical key tag of the key. (RFC2535 4.1.6) =head1 COPYRIGHT Copyright (c)2003-2005 RIPE NCC. Author Olaf M. Kolkman All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC4034, RFC3755 L =cut Net-DNS-1.07/lib/Net/DNS/RR/L32.pm0000644000175000017500000000747213031240164015322 0ustar willemwillempackage Net::DNS::RR::L32; # # $Id: L32.pm 1408 2015-10-06 20:35:56Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1408 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::L32 - DNS L32 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(preference locator32)} = unpack "\@$offset n a4", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{locator32}; pack 'n a4', $self->{preference}, $self->{locator32}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{locator32}; join ' ', $self->preference, $self->locator32; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->locator32(shift); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub locator32 { my $self = shift; my $prfx = shift; $self->{locator32} = pack 'C* @4', split /\./, $prfx if defined $prfx; join '.', unpack 'C4', $self->{locator32} if $self->{locator32}; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN L32 preference locator32'); $rr = new Net::DNS::RR( name => 'example.com', type => 'L32', preference => 10, locator32 => '10.1.02.0' ); =head1 DESCRIPTION Class for DNS 32-bit Locator (L32) resource records. The L32 resource record is used to hold 32-bit Locator values for ILNPv4-capable nodes. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this L32 record among other L32 records associated with this owner name. Lower values are preferred over higher values. =head2 locator32 $locator32 = $rr->locator32; The Locator32 field is an unsigned 32-bit integer in network byte order that has the same syntax and semantics as a 32-bit IPv4 routing prefix. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6742 =cut Net-DNS-1.07/lib/Net/DNS/RR/X25.pm0000644000175000017500000000556213031240164015336 0ustar willemwillempackage Net::DNS::RR::X25; # # $Id: X25.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::X25 - DNS X25 resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = decode Net::DNS::Text( $data, $offset ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $address = $self->{address} || return ''; $address->encode; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $address = $self->{address} || return ''; $address->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); } sub address { my $self = shift; $self->{address} = new Net::DNS::Text(shift) if scalar @_; $self->{address}->value if $self->{address}; } sub PSDNaddress { &address; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name X25 PSDNaddress'); =head1 DESCRIPTION Class for DNS X25 resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 PSDNaddress =head2 address $address = $rr->address; $rr->address( $address ); The PSDN-address is a string of decimal digits, beginning with the 4 digit DNIC (Data Network Identification Code), as specified in X.121. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1183 Section 3.1 =cut Net-DNS-1.07/lib/Net/DNS/RR/MX.pm0000644000175000017500000000741013031240164015276 0ustar willemwillempackage Net::DNS::RR::MX; # # $Id: MX.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MX - DNS MX resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{exchange} = decode Net::DNS::DomainName1035( $data, $offset + 2, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $exchange = $self->{exchange} || return ''; pack 'n a*', $self->preference, $exchange->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $exchange = $self->{exchange} || return ''; join ' ', $self->preference, $exchange->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->exchange(shift); } sub _defaults { ## specify RR attribute default values my $self = shift; $self->preference(10); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub exchange { my $self = shift; $self->{exchange} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{exchange}->name if $self->{exchange}; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name MX preference exchange'); =head1 DESCRIPTION DNS Mail Exchanger (MX) resource record =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer which specifies the preference given to this RR among others at the same owner. Lower values are preferred. =head2 exchange $exchange = $rr->exchange; $rr->exchange( $exchange ); A domain name which specifies a host willing to act as a mail exchange for the owner name. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.9 =cut Net-DNS-1.07/lib/Net/DNS/RR/SSHFP.pm0000644000175000017500000001127213031240164015636 0ustar willemwillempackage Net::DNS::RR::SSHFP; # # $Id: SSHFP.pm 1488 2016-06-07 09:04:50Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1488 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SSHFP - DNS SSHFP resource record =cut use integer; use constant BABBLE => defined eval 'require Digest::BubbleBabble'; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $size = $self->{rdlength} - 2; @{$self}{qw(algorithm fptype fpbin)} = unpack "\@$offset C2 a$size", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{fpbin}; pack 'C2 a*', @{$self}{qw(algorithm fptype fpbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{fpbin}; $self->_annotation( $self->babble ) if BABBLE; my @fprint = split /(\S{64})/, $self->fp; my @rdata = ( $self->algorithm, $self->fptype, @fprint ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->algorithm(shift); $self->fptype(shift); $self->fp(@_); } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; $self->{algorithm} || 0; } sub fptype { my $self = shift; $self->{fptype} = 0 + shift if scalar @_; $self->{fptype} || 0; } sub fp { my $self = shift; $self->fpbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->fpbin() if defined wantarray; } sub fpbin { my $self = shift; $self->{fpbin} = shift if scalar @_; $self->{fpbin} || ""; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->fpbin ) : ''; } sub fingerprint { &fp; } ## historical 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name SSHFP algorithm fptype fp'); =head1 DESCRIPTION DNS SSH Fingerprint (SSHFP) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The 8-bit algorithm number describes the algorithm used to construct the public key. =head2 fptype $fptype = $rr->fptype; $rr->fptype( $fptype ); The 8-bit fingerprint type number describes the message-digest algorithm used to calculate the fingerprint of the public key. =head2 fingerprint =head2 fp $fp = $rr->fp; $rr->fp( $fp ); Hexadecimal representation of the fingerprint digest. =head2 fpbin $fpbin = $rr->fpbin; $rr->fpbin( $fpbin ); Returns opaque octet string representing the fingerprint digest. =head2 babble print $rr->babble; The babble() method returns the 'BabbleBubble' representation of the fingerprint if the Digest::BubbleBabble package is available, otherwise an empty string is returned. Bubble babble represents a message digest as a string of "real" words, to make the fingerprint easier to remember. The "words" are not necessarily real words, but they look more like words than a string of hex characters. Bubble babble fingerprinting is used by the SSH2 suite (and consequently by Net::SSH::Perl, the Perl SSH implementation) to display easy-to-remember key fingerprints. The 'BubbleBabble' string is appended as a comment when the string method is called. =head1 COPYRIGHT Copyright (c)2007 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC4255 =cut Net-DNS-1.07/lib/Net/DNS/RR/OPT.pm0000644000175000017500000001622713031240164015422 0ustar willemwillempackage Net::DNS::RR::OPT; # # $Id: OPT.pm 1474 2016-04-12 13:21:25Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1474 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::OPT - DNS OPT resource record =cut use integer; use Carp; use Net::DNS::Parameters; use constant CLASS_TTL_RDLENGTH => length pack 'n N n', (0) x 3; use constant OPT => typebyname qw(OPT); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; my $index = $offset - CLASS_TTL_RDLENGTH; # OPT redefines class and TTL fields @{$self}{qw(size rcode version flags)} = unpack "\@$index n C2 n", $$data; @{$self}{rcode} = @{$self}{rcode} << 4; delete @{$self}{qw(class ttl)}; while ( $offset <= $limit - 4 ) { my ( $code, $length ) = unpack "\@$offset nn", $$data; $offset += 4; $self->option( $code, substr $$data, $offset, $length ); $offset += $length; } } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $rdata = ''; foreach ( $self->options ) { my $value = $self->option($_); $rdata .= pack 'nna*', $_, length($value), $value; } return $rdata; } sub encode { ## overide RR method my $self = shift; my $data = $self->_encode_rdata; my $size = $self->size; my @xttl = ( $self->rcode >> 4, $self->version, $self->flags ); pack 'C n n C2n n a*', 0, OPT, $size, @xttl, length($data), $data; } sub string { ## overide RR method my $self = shift; my $edns = $self->version; my $flags = sprintf '%04x', $self->flags; my $rcode = $self->rcode; my $size = $self->size; my @option = sort { $a <=> $b } $self->options; my @lines = map sprintf( "%s\t%s", ednsoptionbyval($_), unpack 'H*', $self->option($_) ), @option; my @format = join "\n;;\t\t", @lines; $rcode = 0 if $rcode < 16; # weird: 1 .. 15 not EDNS codes!! my $rc = exists( $self->{rdlength} ) && $rcode ? "$rcode + [4-bits]" : rcodebyval($rcode); $rc = 'BADVERS' if $rcode == 16; # code 16 unambiguous here return <<"QQ"; ;; EDNS version $edns ;; flags: $flags ;; rcode: $rc ;; size: $size ;; option: @format QQ } my ( $class, $ttl ); sub class { ## overide RR method carp qq[Usage: OPT has no "class" attribute, please use "size()"] unless $class++; &size; } sub ttl { ## overide RR method my $self = shift; carp qq[Usage: OPT has no "ttl" attribute, please use "flags()" or "rcode()"] unless $ttl++; my @rcode = map unpack( 'C', pack 'N', $_ ), @_; my @flags = map unpack( 'x2n', pack 'N', $_ ), @_; pack 'C2n', $self->rcode(@rcode), $self->version, $self->flags(@flags); } sub version { my $version = shift->{version}; return defined($version) ? $version : 0; } sub size { my $self = shift; for ( $self->{size} ) { my $UDP_size = 0; ( $UDP_size, $_ ) = ( shift || 0 ) if scalar @_; return $UDP_size > 512 ? ( $_ = $UDP_size ) : 512 unless $_; return $_ > 512 ? $_ : 512; } } sub rcode { my $self = shift; return $self->{rcode} || 0 unless scalar @_; delete $self->{rdlength}; # (ab)used to signal incomplete value my $val = shift || 0; $self->{rcode} = $val < 16 ? 0 : $val; # discard non-EDNS rcodes 1 .. 15 } sub flags { my $self = shift; return $self->{flags} || 0 unless scalar @_; $self->{flags} = shift; } sub options { my ($self) = @_; &option; return keys %{$self->{option}}; } sub option { my $self = shift; my $options = $self->{option} ||= {}; while ( scalar @_ ) { my $number = ednsoptionbyname(shift); return $options->{$number} unless scalar @_; my $value = shift; delete $options->{$number}; $options->{$number} = $value if defined $value; } } sub _specified { my $self = shift; my @spec = grep $self->{$_}, qw(size flags rcode option); scalar @spec; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $opt = new Net::DNS::RR( type => "OPT", flags => 0x8000, # extended flags rcode => 0, # extended RCODE size => 1280, # UDP payload size ); =head1 DESCRIPTION EDNS OPT pseudo resource record. The OPT record supports EDNS protocol extensions and is not intended to be created, accessed or modified directly by user applications. All access to EDNS features is performed indirectly by operations on the packet header. The underlying mechanism is entirely hidden from the user. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 version $version = $rr->version; The version of EDNS used by this OPT record. =head2 size $size = $packet->edns->size; $more = $packet->edns->size(1280); size() advertises the maximum size (octets) of UDP packet that can be reassembled in the network stack of the originating host. =head2 rcode $extended_rcode = $packet->header->rcode; $incomplete_rcode = $packet->edns->rcode; The 12 bit extended RCODE. The most significant 8 bits reside in the OPT record. The least significant 4 bits can only be obtained from the packet header. =head2 flags $edns_flags = $packet->edns->flags; $do = $packet->header->do; $packet->header->do(1); 16 bit field containing EDNS extended header flags. =head2 options, option @option = $packet->edns->options; $octets = $packet->edns->option($option_code); $packet->edns->option( NSID => 'value' ); $packet->edns->option( 3 => 'value' ); When called in a list context, options() returns a list of option codes found in the OPT record. When called with a single argument, option() returns the octet string corresponding to the specified option. The function value is undefined if the specified option is absent. Options can be changed by providing an argument list containing one or more (name => value) pairs to be added or modified. The effect of such changes is cumulative. An option is deleted if the value is undefined. =head1 COPYRIGHT Copyright (c)2001,2002 RIPE NCC. Author Olaf M. Kolkman. Portions Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6891, RFC3225 =cut Net-DNS-1.07/lib/Net/DNS/RR/MR.pm0000644000175000017500000000541013031240164015266 0ustar willemwillempackage Net::DNS::RR::MR; # # $Id: MR.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MR - DNS MR resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{newname} = decode Net::DNS::DomainName1035(@_); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $newname = $self->{newname} || return ''; $newname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $newname = $self->{newname} || return ''; $newname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->newname(shift); } sub newname { my $self = shift; $self->{newname} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{newname}->name if $self->{newname}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name MR newname'); =head1 DESCRIPTION Class for DNS Mail Rename (MR) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 newname $newname = $rr->newname; $rr->newname( $newname ); A domain name which specifies a mailbox which is the proper rename of the specified mailbox. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.8 =cut Net-DNS-1.07/lib/Net/DNS/RR/GPOS.pm0000644000175000017500000001023513031240164015521 0ustar willemwillempackage Net::DNS::RR::GPOS; # # $Id: GPOS.pm 1382 2015-08-26 20:39:33Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1382 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::GPOS - DNS GPOS resource record =cut use integer; use Carp; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{latitude}, $offset ) = decode Net::DNS::Text( $data, $offset ) if $offset < $limit; ( $self->{longitude}, $offset ) = decode Net::DNS::Text( $data, $offset ) if $offset < $limit; ( $self->{altitude}, $offset ) = decode Net::DNS::Text( $data, $offset ) if $offset < $limit; croak('corrupt GPOS data') unless $offset == $limit; # more or less FUBAR } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{altitude}; join '', map $self->{$_}->encode, qw(latitude longitude altitude); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{altitude}; join ' ', map $self->{$_}->string, qw(latitude longitude altitude); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->latitude(shift); $self->longitude(shift); $self->altitude(shift); die 'too many arguments for GPOS' if scalar @_; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata(qw(0.0 0.0 0.0)); } sub latitude { my $self = shift; $self->{latitude} = _fp2text(shift) if scalar @_; _text2fp( $self->{latitude} ) if defined wantarray; } sub longitude { my $self = shift; $self->{longitude} = _fp2text(shift) if scalar @_; _text2fp( $self->{longitude} ) if defined wantarray; } sub altitude { my $self = shift; $self->{altitude} = _fp2text(shift) if scalar @_; _text2fp( $self->{altitude} ) if defined wantarray; } ######################################## sub _fp2text { return new Net::DNS::Text( sprintf( '%1.10g', shift ) ); } sub _text2fp { no integer; return 0.0 + shift->value; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name GPOS latitude longitude altitude'); =head1 DESCRIPTION Class for DNS Geographical Position (GPOS) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 latitude $latitude = $rr->latitude; $rr->latitude( $latitude ); Floating-point representation of latitude, in degrees. =head2 longitude $longitude = $rr->longitude; $rr->longitude( $longitude ); Floating-point representation of longitude, in degrees. =head2 altitude $altitude = $rr->altitude; $rr->altitude( $altitude ); Floating-point representation of altitude, in metres. =head1 COPYRIGHT Copyright (c)1997,1998 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1712 =cut Net-DNS-1.07/lib/Net/DNS/RR/LOC.pm0000644000175000017500000001764013031240164015375 0ustar willemwillempackage Net::DNS::RR::LOC; # # $Id: LOC.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::LOC - DNS LOC resource record =cut use integer; use Carp; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $version = $self->{version} = unpack "\@$offset C", $$data; @{$self}{qw(size hp vp latitude longitude altitude)} = unpack "\@$offset xC3N3", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{longitude}; pack 'C4N3', @{$self}{qw(version size hp vp latitude longitude altitude)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{longitude}; my ( $altitude, @precision ) = map $self->$_() . 'm', qw(altitude size hp vp); my $precision = join ' ', @precision; for ($precision) { s/\s+10m$//; s/\s+10000m$//; s/\s*1m$//; } my @rdata = ( $self->latitude, '', $self->longitude, '', $altitude, $precision ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; my @lat; while ( scalar @_ ) { my $this = shift; push( @lat, $this ); last if $this =~ /[NSns]/; } $self->latitude(@lat); my @long; while ( scalar @_ ) { my $this = shift; push( @long, $this ); last if $this =~ /[EWew]/; } $self->longitude(@long); foreach my $attr (qw(altitude size hp vp)) { $self->$attr(@_); shift; } } sub _defaults { ## specify RR attribute default values my $self = shift; $self->{version} = 0; $self->size(1); $self->hp(10000); $self->vp(10); } sub latitude { my $self = shift; $self->{latitude} = _encode_lat(@_) if scalar @_; return _decode_lat( $self->{latitude} ) if defined wantarray; } sub longitude { my $self = shift; $self->{longitude} = _encode_lat(@_) if scalar @_; return undef unless defined wantarray; return _decode_lat( $self->{longitude} ) unless wantarray; my @long = map { s/N/E/; s/S/W/; $_ } _decode_lat( $self->{longitude} ); } sub altitude { my $self = shift; $self->{altitude} = _encode_alt(shift) if scalar @_; _decode_alt( $self->{altitude} ) if defined wantarray; } sub size { my $self = shift; $self->{size} = _encode_prec(shift) if scalar @_; _decode_prec( $self->{size} ) if defined wantarray; } sub hp { my $self = shift; $self->{hp} = _encode_prec(shift) if scalar @_; _decode_prec( $self->{hp} ) if defined wantarray; } sub horiz_pre { &hp; } # uncoverable pod sub vp { my $self = shift; $self->{vp} = _encode_prec(shift) if scalar @_; _decode_prec( $self->{vp} ) if defined wantarray; } sub vert_pre { &vp; } # uncoverable pod sub latlon { my $self = shift; my ( $lat, @lon ) = @_; my @pair = scalar $self->latitude(@_), scalar $self->longitude(@lon); } sub version { shift->{version}; } ######################################## no integer; use constant ALTITUDE0 => 10000000; use constant LATITUDE0 => 0x80000000; sub _decode_lat { my $msec = shift || LATITUDE0; return int( 0.5 + ( $msec - LATITUDE0 ) / 0.36 ) / 10000000 unless wantarray; use integer; my $abs = abs( $msec - LATITUDE0 ); my $deg = int( $abs / 3600000 ); my $min = int( $abs / 60000 ) % 60; no integer; my $sec = ( $abs % 60000 ) / 1000; return ( $deg, $min, $sec, ( $msec < LATITUDE0 ? 'S' : 'N' ) ); } sub _encode_lat { my @ang = scalar @_ > 1 ? (@_) : ( split /[\s\260'"]+/, shift ); my $ang = ( 0 + shift @ang ) * 3600000; my $neg = ( @ang ? pop @ang : '' ) =~ /[SWsw]/; $ang += ( @ang ? shift @ang : 0 ) * 60000; $ang += ( @ang ? shift @ang : 0 ) * 1000; return int( 0.5 + ( $neg ? LATITUDE0 - $ang : LATITUDE0 + $ang ) ); } sub _decode_alt { my $cm = ( shift || ALTITUDE0 ) - ALTITUDE0; return 0.01 * $cm; } sub _encode_alt { ( my $argument = shift ) =~ s/[Mm]$//; $argument += 0; return int( 0.5 + ALTITUDE0 + 100 * $argument ); } my @power10 = ( 0.01, 0.1, 1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 0, 0, 0, 0, 0 ); sub _decode_prec { my $argument = shift || 0; my $mantissa = $argument >> 4; return $mantissa * $power10[$argument & 0x0F]; } sub _encode_prec { ( my $argument = shift ) =~ s/[Mm]$//; foreach my $exponent ( 0 .. 9 ) { next unless $argument < $power10[1 + $exponent]; my $mantissa = int( 0.5 + $argument / $power10[$exponent] ); return ( $mantissa & 0xF ) << 4 | $exponent; } } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name LOC latitude longitude altitude size hp vp'); =head1 DESCRIPTION DNS geographical location (LOC) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 latitude $latitude = $rr->latitude; ($deg, $min, $sec, $ns ) = $rr->latitude; $rr->latitude( 42.357990 ); $rr->latitude( 42, 21, 28.764, 'N' ); $rr->latitude( '42 21 28.764 N' ); When invoked in scalar context, latitude is returned in degrees, a negative ordinate being south of the equator. When invoked in list context, latitude is returned as a list of separate degree, minute, and second values followed by N or S as appropriate. Optional replacement values may be represented as single value, list or formatted string. Trailing zero values are optional. =head2 longitude $longitude = $rr->longitude; ($deg, $min, $sec, $ew ) = $rr->longitude; $rr->longitude( -71.014338 ); $rr->longitude( 71, 0, 51.617, 'W' ); $rr->longitude( '71 0 51.617 W' ); When invoked in scalar context, longitude is returned in degrees, a negative ordinate being west of the prime meridian. When invoked in list context, longitude is returned as a list of separate degree, minute, and second values followed by E or W as appropriate. =head2 altitude $altitude = $rr->altitude; Represents altitude, in metres, relative to the WGS 84 reference spheroid used by GPS. =head2 size $size = $rr->size; Represents the diameter, in metres, of a sphere enclosing the described entity. =head2 hp $hp = $rr->hp; Represents the horizontal precision of the data expressed as the diameter, in metres, of the circle of error. =head2 vp $vp = $rr->vp; Represents the vertical precision of the data expressed as the total spread, in metres, of the distribution of possible values. =head2 latlon ($lat, $lon) = $rr->latlon; $rr->latlon($lat, $lon); Representation of the latitude and longitude coordinate pair as signed floating-point degrees. =head2 version $version = $rr->version; Version of LOC protocol. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2011 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1876 =cut Net-DNS-1.07/lib/Net/DNS/RR/SOA.pm0000644000175000017500000001731313031240164015377 0ustar willemwillempackage Net::DNS::RR::SOA; # # $Id: SOA.pm 1488 2016-06-07 09:04:50Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1488 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SOA - DNS SOA resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Mailbox; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; ( $self->{mname}, $offset ) = decode Net::DNS::DomainName1035(@_); ( $self->{rname}, $offset ) = decode Net::DNS::Mailbox1035( $data, $offset, @opaque ); @{$self}{qw(serial refresh retry expire minimum)} = unpack "\@$offset N5", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $rname = $self->{rname} || return ''; my $rdata = $self->{mname}->encode(@_); $rdata .= $rname->encode( $offset + length($rdata), @opaque ); $rdata .= pack 'N5', $self->serial, @{$self}{qw(refresh retry expire minimum)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{rname}; my $mname = $self->{mname}->string; my $rname = $self->{rname}->string; my $serial = $self->serial; my $spacer = length "$serial" > 7 ? "" : "\t"; my @rdata = $mname, $rname, join "\n\t\t\t\t", "\t\t\t$serial$spacer\t;serial", "$self->{refresh}\t\t;refresh", "$self->{retry}\t\t;retry", "$self->{expire}\t\t;expire", "$self->{minimum}\t\t;minimum\n"; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->mname(shift); $self->rname(shift); $self->serial(shift); for (qw(refresh retry expire minimum)) { $self->$_( Net::DNS::RR::ttl( {}, shift ) ) if scalar @_; } } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata(qw(. . 0 4h 1h 3w 1h)); $self->{serial} = undef; } sub mname { my $self = shift; $self->{mname} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{mname}->name if $self->{mname}; } sub rname { my $self = shift; $self->{rname} = new Net::DNS::Mailbox1035(shift) if scalar @_; $self->{rname}->address if $self->{rname}; } sub serial { my $self = shift; return $self->{serial} || 0 unless scalar @_; # current/default value my $value = shift; # replace if in sequence return $self->{serial} = 0 + $value if _ordered( $self->{serial}, $value ); # unwise to assume 32-bit arithmetic, or that integer overflow goes unpunished my $serial = ( 0 + $self->{serial} ) & 0xFFFFFFFF; return $self->{serial} = $serial ^ 0xFFFFFFFF if ( $serial & 0x7FFFFFFF ) == 0x7FFFFFFF; # wrap return $self->{serial} = $serial + 1; # increment } sub refresh { my $self = shift; $self->{refresh} = 0 + shift if scalar @_; $self->{refresh} || 0; } sub retry { my $self = shift; $self->{retry} = 0 + shift if scalar @_; $self->{retry} || 0; } sub expire { my $self = shift; $self->{expire} = 0 + shift if scalar @_; $self->{expire} || 0; } sub minimum { my $self = shift; $self->{minimum} = 0 + shift if scalar @_; $self->{minimum} || 0; } ######################################## sub _ordered($$) { ## irreflexive 32-bit partial ordering use integer; my ( $a, $b ) = @_; return defined $b unless defined $a; # ( undef, any ) return 0 unless defined $b; # ( any, undef ) # unwise to assume 32-bit arithmetic, or that integer overflow goes unpunished if ( $a < 0 ) { # translate $a<0 region $a = ( $a ^ 0x80000000 ) & 0xFFFFFFFF; # 0 <= $a < 2**31 $b = ( $b ^ 0x80000000 ) & 0xFFFFFFFF; # -2**31 <= $b < 2**32 } return $a < $b ? ( $a > ( $b - 0x80000000 ) ) : ( $b < ( $a - 0x80000000 ) ); } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name SOA mname rname 0 14400 3600 1814400 3600'); =head1 DESCRIPTION Class for DNS Start of Authority (SOA) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 mname $mname = $rr->mname; $rr->mname( $mname ); The domain name of the name server that was the original or primary source of data for this zone. =head2 rname $rname = $rr->rname; $rr->rname( $rname ); The mailbox which identifies the person responsible for maintaining this zone. =head2 serial $serial = $rr->serial; $serial = $rr->serial(value); Unsigned 32 bit version number of the original copy of the zone. Zone transfers preserve this value. RFC1982 defines a strict (irreflexive) partial ordering for zone serial numbers. The serial number will be incremented unless the replacement value argument satisfies the ordering constraint. =head2 refresh $refresh = $rr->refresh; $rr->refresh( $refresh ); A 32 bit time interval before the zone should be refreshed. =head2 retry $retry = $rr->retry; $rr->retry( $retry ); A 32 bit time interval that should elapse before a failed refresh should be retried. =head2 expire $expire = $rr->expire; $rr->expire( $expire ); A 32 bit time value that specifies the upper limit on the time interval that can elapse before the zone is no longer authoritative. =head2 minimum $minimum = $rr->minimum; $rr->minimum( $minimum ); The unsigned 32 bit minimum TTL field that should be exported with any RR from this zone. =head1 Zone Serial Number Management The internal logic of the serial() method offers support for several widely used zone serial numbering policies. =head2 Strictly Sequential $successor = $soa->serial( SEQUENTIAL ); The existing serial number is incremented modulo 2**32 because the value returned by the auxiliary SEQUENTIAL() function can never satisfy the serial number ordering constraint. =head2 Date Encoded $successor = $soa->serial( YYYYMMDDxx ); The 32 bit value returned by the auxiliary YYYYMMDDxx() function will be used if it satisfies the ordering constraint, otherwise the serial number will be incremented as above. Serial number increments must be limited to 100 per day for the date information to remain useful. =head2 Time Encoded $successor = $soa->serial( UNIXTIME ); The 32 bit value returned by the auxiliary UNIXTIME() function will used if it satisfies the ordering constraint, otherwise the existing serial number will be incremented as above. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2003 Chris Reinhardt. Portions Copyright (c)2010,2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.13, RFC1982 =cut Net-DNS-1.07/lib/Net/DNS/RR/NULL.pm0000644000175000017500000000411113031240164015517 0ustar willemwillempackage Net::DNS::RR::NULL; # # $Id: NULL.pm 1348 2015-05-27 09:55:13Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1348 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NULL - DNS NULL resource record =cut 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name NULL \# length hexdata ...'); =head1 DESCRIPTION Class for DNS null (NULL) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 rdlength $rdlength = $rr->rdlength; Returns the length of the record data section. =head2 rdata $rdata = $rr->rdata; $rr->rdata( $rdata ); Returns the record data section as binary data. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.10 =cut Net-DNS-1.07/lib/Net/DNS/RR/OPENPGPKEY.pm0000644000175000017500000000610113031240164016427 0ustar willemwillempackage Net::DNS::RR::OPENPGPKEY; # # $Id: OPENPGPKEY.pm 1499 2016-08-24 11:29:20Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1499 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::OPENPGPKEY - DNS OPENPGPKEY resource record =cut use integer; use MIME::Base64; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $length = $self->{rdlength}; $self->keysbin( substr $$data, $offset, $length ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; pack 'a*', $self->keysbin; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @base64 = split /\s+/, encode_base64( $self->keysbin ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->keys(@_); } sub keys { my $self = shift; $self->keysbin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->keysbin(), "" ) if defined wantarray; } sub keysbin { my $self = shift; $self->{keysbin} = shift if scalar @_; $self->{keysbin} || ""; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name OPENPGPKEY keys'); =head1 DESCRIPTION Class for OpenPGP Key (OPENPGPKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 keys $keys = $rr->keys; $rr->keys( $keys ); Base64 encoded representation of the binary OpenPGP public key material. =head2 keysbin $keysbin = $rr->keysbin; $rr->keysbin( $keysbin ); Binary representation of the public key material. The key material is a simple concatenation of OpenPGP keys in RFC4880 format. =head1 COPYRIGHT Copyright (c)2014 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC7929 =cut Net-DNS-1.07/lib/Net/DNS/RR/MINFO.pm0000644000175000017500000000762713031240164015634 0ustar willemwillempackage Net::DNS::RR::MINFO; # # $Id: MINFO.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MINFO - DNS MINFO resource record =cut use integer; use Net::DNS::Mailbox; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; ( $self->{rmailbx}, $offset ) = decode Net::DNS::Mailbox1035(@_); ( $self->{emailbx}, $offset ) = decode Net::DNS::Mailbox1035( $data, $offset, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $emailbx = $self->{emailbx} || return ''; my $rdata = $self->{rmailbx}->encode(@_); $rdata .= $emailbx->encode( $offset + length $rdata, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $emailbx = $self->{emailbx} || return ''; my @rdata = ( $self->{rmailbx}->string, $emailbx->string ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->rmailbx(shift); $self->emailbx(shift); } sub rmailbx { my $self = shift; $self->{rmailbx} = new Net::DNS::Mailbox1035(shift) if scalar @_; $self->{rmailbx}->address if $self->{rmailbx}; } sub emailbx { my $self = shift; $self->{emailbx} = new Net::DNS::Mailbox1035(shift) if scalar @_; $self->{emailbx}->address if $self->{emailbx}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name MINFO rmailbx emailbx'); =head1 DESCRIPTION Class for DNS Mailbox Information (MINFO) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 rmailbx $rmailbx = $rr->rmailbx; $rr->rmailbx( $rmailbx ); A domain name which specifies a mailbox which is responsible for the mailing list or mailbox. If this domain name names the root, the owner of the MINFO RR is responsible for itself. Note that many existing mailing lists use a mailbox X-request to identify the maintainer of mailing list X, e.g., Msgroup-request for Msgroup. This field provides a more general mechanism. =head2 emailbx $emailbx = $rr->emailbx; $rr->emailbx( $emailbx ); A domain name which specifies a mailbox which is to receive error messages related to the mailing list or mailbox specified by the owner of the MINFO RR (similar to the ERRORS-TO: field which has been proposed). If this domain name names the root, errors should be returned to the sender of the message. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.3.7 =cut Net-DNS-1.07/lib/Net/DNS/RR/TSIG.pm0000644000175000017500000004767213031240164015536 0ustar willemwillempackage Net::DNS::RR::TSIG; # # $Id: TSIG.pm 1508 2016-09-29 12:58:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1508 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::TSIG - DNS TSIG resource record =cut use integer; use Carp; eval 'require Digest::HMAC'; eval 'require Digest::MD5'; eval 'require Digest::SHA'; eval 'require MIME::Base64'; use Net::DNS::DomainName; use Net::DNS::Parameters; use constant ANY => classbyname qw(ANY); use constant TSIG => typebyname qw(TSIG); { # source: http://www.iana.org/assignments/tsig-algorithm-names my @algbyname = ( 'HMAC-MD5.SIG-ALG.REG.INT' => 157, 'HMAC-SHA1' => 161, 'HMAC-SHA224' => 162, 'HMAC-SHA256' => 163, 'HMAC-SHA384' => 164, 'HMAC-SHA512' => 165, ); my @algbyalias = ( 'HMAC-MD5' => 157, 'HMAC-SHA' => 161, ); my %algbyval = reverse @algbyname; my $map = sub { my $arg = shift; return $arg if $arg =~ /^\d/; $arg =~ s/[^A-Za-z0-9]//g; # strip non-alphanumerics uc($arg); }; my @pairedval = sort ( 1 .. 254, 1 .. 254 ); # also accept number my %algbyname = map &$map($_), @algbyalias, @algbyname, @pairedval; sub _algbyname { my $key = uc shift; # synthetic key $key =~ s/[^A-Z0-9]//g; # strip non-alphanumerics $algbyname{$key}; } sub _algbyval { my $value = shift; $algbyval{$value}; } } sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{algorithm}, $offset ) = decode Net::DNS::DomainName(@_); # Design decision: Use 32 bits, which will work until the end of time()! @{$self}{qw(time_signed fudge)} = unpack "\@$offset xxN n", $$data; $offset += 8; my $mac_size = unpack "\@$offset n", $$data; $self->{macbin} = unpack "\@$offset xx a$mac_size", $$data; $offset += $mac_size + 2; @{$self}{qw(original_id error)} = unpack "\@$offset nn", $$data; $offset += 4; my $other_size = unpack "\@$offset n", $$data; $self->{other} = unpack "\@$offset xx a$other_size", $$data; $offset += $other_size + 2; croak('misplaced or corrupt TSIG') unless $limit == length $$data; my $raw = substr $$data, 0, $self->{offset}; $self->{rawref} = \$raw; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $macbin = $self->macbin; unless ($macbin) { my ( $offset, undef, $packet ) = @_; my $sigdata = $self->sig_data($packet); # form data to be signed $macbin = $self->macbin( $self->_mac_function($sigdata) ); $self->original_id( $packet->header->id ); } my $rdata = $self->{algorithm}->canonical; # Design decision: Use 32 bits, which will work until the end of time()! $rdata .= pack 'xxN n', $self->time_signed, $self->fudge; $rdata .= pack 'na*', length($macbin), $macbin; $rdata .= pack 'nn', $self->original_id, $self->{error}; my $other = $self->other; $rdata .= pack 'na*', length($other), $other; return $rdata; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->algorithm(157); $self->class('ANY'); $self->error(0); $self->fudge(300); $self->other(''); } sub _size { ## estimate encoded size my $self = shift; my $clone = bless {%$self}, ref($self); # shallow clone length $clone->encode( 0, undef, new Net::DNS::Packet() ); } sub encode { ## overide RR method my $self = shift; my $kname = $self->{owner}->encode(); # uncompressed key name my $rdata = eval { $self->_encode_rdata(@_) } || ''; pack 'a* n2 N n a*', $kname, TSIG, ANY, 0, length $rdata, $rdata; } sub string { ## overide RR method my $self = shift; my $owner = $self->{owner}->string; my $type = $self->type; my $algorithm = $self->algorithm; my $time_signed = $self->time_signed; my $fudge = $self->fudge; my $signature = $self->mac; my $original_id = $self->original_id; my $error = $self->error; my $other = $self->other; return <<"QQ"; ; $owner $type ; algorithm: $algorithm ; time signed: $time_signed fudge: $fudge ; signature: $signature ; original id: $original_id ; $error $other QQ } sub algorithm { &_algorithm; } sub key { my $self = shift; $self->keybin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->keybin(), "" ) if defined wantarray; } sub keybin { &_keybin; } sub time_signed { my $self = shift; $self->{time_signed} = 0 + shift if scalar @_; $self->{time_signed} = time() unless $self->{time_signed}; } sub fudge { my $self = shift; $self->{fudge} = 0 + shift if scalar @_; $self->{fudge} || 0; } sub mac { my $self = shift; $self->macbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->macbin() if defined wantarray; } sub macbin { my $self = shift; $self->{macbin} = shift if scalar @_; $self->{macbin} || ""; } sub prior_mac { my $self = shift; $self->prior_macbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->prior_macbin() if defined wantarray; } sub prior_macbin { my $self = shift; $self->{prior_macbin} = shift if scalar @_; $self->{prior_macbin} || ""; } sub request_mac { my $self = shift; $self->request_macbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->request_macbin() if defined wantarray; } sub request_macbin { my $self = shift; $self->{request_macbin} = shift if scalar @_; $self->{request_macbin} || ""; } sub original_id { my $self = shift; $self->{original_id} = 0 + shift if scalar @_; $self->{original_id} || 0; } sub error { my $self = shift; $self->{error} = rcodebyname(shift) if scalar @_; rcodebyval( $self->{error} ); } sub other { my $self = shift; $self->{other} = shift if scalar @_; my $time = $self->{error} == 18 ? pack 'xxN', time() : ''; $self->{other} = $time unless $self->{other}; } sub other_data {&other} # uncoverable pod sub sig_function { my $self = shift; return $self->{sig_function} unless scalar @_; $self->{sig_function} = shift; } sub sign_func { &sig_function; } # uncoverable pod sub sig_data { my ( $self, $message ) = @_; if ( ref($message) ) { die 'missing packet reference' unless $message->isa('Net::DNS::Packet'); my @unsigned = grep ref($_) ne ref($self), @{$message->{additional}}; local $message->{additional} = \@unsigned; # remake header image my @part = qw(question answer authority additional); my @size = map scalar( @{$message->{$_}} ), @part; if ( my $rawref = $self->{rawref} ) { delete $self->{rawref}; my $hbin = pack 'n6', $self->original_id, $message->{status}, @size; $message = join '', $hbin, substr $$rawref, length $hbin; } else { my $data = $message->data; my $hbin = pack 'n6', $message->{id}, $message->{status}, @size; $message = join '', $hbin, substr $data, length $hbin; } } # Design decision: Use 32 bits, which will work until the end of time()! my $time = pack 'xxN n', $self->time_signed, $self->fudge; # Insert the prior MAC if present (multi-packet message). $self->prior_macbin( $self->{link}->macbin ) if $self->{link}; my $prior_macbin = $self->prior_macbin; return pack 'na* a* a*', length($prior_macbin), $prior_macbin, $message, $time if $prior_macbin; # Insert the request MAC if present (used to validate responses). my $req_mac = $self->request_macbin; my $sigdata = $req_mac ? pack( 'na*', length($req_mac), $req_mac ) : ''; $sigdata .= $message || ''; my $kname = $self->{owner}->canonical; # canonical key name $sigdata .= pack 'a* n N', $kname, ANY, 0; $sigdata .= $self->{algorithm}->canonical; # canonical algorithm name $sigdata .= $time; $sigdata .= pack 'n', $self->{error}; my $other = $self->other; $sigdata .= pack 'na*', length($other), $other; return $sigdata; } sub create { my $class = shift; my $karg = shift; croak 'argument undefined' unless defined $karg; if ( ref($karg) ) { if ( $karg->isa('Net::DNS::Packet') ) { my $sigrr = $karg->sigrr; croak 'no TSIG in request packet' unless defined $sigrr; return new Net::DNS::RR( # ( request, options ) name => $sigrr->name, type => 'TSIG', algorithm => $sigrr->algorithm, request_macbin => $sigrr->macbin, @_ ); } elsif ( ref($karg) eq __PACKAGE__ ) { my $tsig = $karg->_chain; $tsig->{macbin} = undef; return $tsig; } elsif ( ref($karg) eq 'Net::DNS::RR::KEY' ) { return new Net::DNS::RR( name => $karg->name, type => 'TSIG', algorithm => $karg->algorithm, key => $karg->key, @_ ); } croak "Usage: create $class(keyfile)\n\tcreate $class(keyname, key)" } elsif ( scalar(@_) == 1 ) { my $key = shift; # ( keyname, key ) return new Net::DNS::RR( name => $karg, type => 'TSIG', key => $key ); } elsif ( $karg =~ /[+.0-9]+private$/ ) { # ( keyfile, options ) require File::Spec; require Net::DNS::ZoneFile; my $keyfile = new Net::DNS::ZoneFile($karg); my ( $alg, $key, $junk ); while ( my $line = $keyfile->_getline ) { for ($line) { ( $junk, $alg ) = split if /Algorithm:/; ( $junk, $key ) = split if /Key:/; } } my ( $vol, $dir, $file ) = File::Spec->splitpath( $keyfile->name ); my $kname; $kname = $1 if $file =~ /^K([^+]+)+.+private$/; return new Net::DNS::RR( name => $kname, type => 'TSIG', algorithm => $alg, key => $key, @_ ); } else { # ( keyfile, options ) require Net::DNS::ZoneFile; my $keyrr = new Net::DNS::ZoneFile($karg)->read; croak 'key file incompatible with TSIG' unless $keyrr->type eq 'KEY'; return new Net::DNS::RR( name => $keyrr->name, type => 'TSIG', algorithm => $keyrr->algorithm, key => $keyrr->key, @_ ); } } sub verify { my $self = shift; my $data = shift; unless ( abs( time() - $self->time_signed ) < $self->fudge ) { $self->error(18); # bad time return; } if ( scalar @_ ) { my $arg = shift; unless ( ref($arg) ) { $self->error(16); # bad sig (multi-packet) return; } my $signerkey = lc( join '+', $self->name, $self->algorithm ); if ( $arg->isa('Net::DNS::Packet') ) { my $request = $arg->sigrr; # request TSIG my $rqstkey = lc( join '+', $request->name, $request->algorithm ); $self->error(17) unless $signerkey eq $rqstkey; $self->request_macbin( $request->macbin ); } elsif ( $arg->isa(__PACKAGE__) ) { my $priorkey = lc( join '+', $arg->name, $arg->algorithm ); $self->error(17) unless $signerkey eq $priorkey; $self->prior_macbin( $arg->macbin ); } else { croak 'Usage: $tsig->verify( $reply, $query )'; } } return if $self->{error}; my $sigdata = $self->sig_data($data); # form data to be verified my $tsigmac = $self->_mac_function($sigdata); my $tsig = $self->_chain; my $macbin = $self->macbin; my $maclen = length $macbin; my $minlen = length($tsigmac) >> 1; # per RFC4635, 3.1 $self->error(16) unless $macbin eq substr $tsigmac, 0, $maclen; $self->error(1) if $maclen < $minlen or $maclen < 10 or $maclen > length $tsigmac; return $self->{error} ? undef : $tsig; } sub vrfyerrstr { my $self = shift; return $self->error; } ######################################## { my %digest = ( '157' => ['Digest::MD5'], '161' => ['Digest::SHA'], '162' => ['Digest::SHA', 224, 64], '163' => ['Digest::SHA', 256, 64], '164' => ['Digest::SHA', 384, 128], '165' => ['Digest::SHA', 512, 128], ); my %keytable; sub _algorithm { ## install sig function in key table my $self = shift; if ( my $algname = shift ) { unless ( my $digtype = _algbyname($algname) ) { $self->{algorithm} = new Net::DNS::DomainName($algname); } else { $algname = _algbyval($digtype); $self->{algorithm} = new Net::DNS::DomainName($algname); my ( $hash, @param ) = @{$digest{$digtype}}; my ( undef, @block ) = @param; my $digest = new $hash(@param); my $function = sub { my $hmac = new Digest::HMAC( shift, $digest, @block ); $hmac->add(shift); return $hmac->digest; }; $self->sig_function($function); my $keyname = ( $self->{owner} || return )->canonical; $keytable{$keyname}{digest} = $function; } } return $self->{algorithm}->name if defined wantarray; } sub _keybin { ## install key in key table my $self = shift; croak 'Unauthorised access to TSIG key material denied' unless scalar @_; my $keyref = $keytable{$self->{owner}->canonical} ||= {}; my $private = shift; # closure keeps private key private $keyref->{key} = sub { my $function = $keyref->{digest}; return &$function( $private, shift ); }; return undef; } sub _mac_function { ## apply keyed hash function to argument my $self = shift; my $owner = $self->{owner}->canonical; $self->algorithm( $self->algorithm ) unless $keytable{$owner}{digest}; my $keyref = $keytable{$owner}; $keyref->{digest} = $self->sig_function unless $keyref->{digest}; my $function = $keyref->{key}; &$function(shift); } } # _chain() creates a new TSIG object linked to the original # RR, for the purpose of signing multi-message transfers. sub _chain { my $self = shift; $self->{link} = undef; bless {%$self, link => $self}, ref($self); } 1; __END__ =head1 SYNOPSIS use Net::DNS; $tsig = create Net::DNS::RR::TSIG( $keyfile ); $tsig = create Net::DNS::RR::TSIG( $keyfile, fudge => 300 ); =head1 DESCRIPTION Class for DNS Transaction Signature (TSIG) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); A domain name which specifies the name of the algorithm. =head2 key $rr->key( $key ); Base64 representation of the key material. =head2 keybin $rr->keybin( $keybin ); Binary representation of the key material. =head2 time_signed $time_signed = $rr->time_signed; $rr->time_signed( $time_signed ); Signing time as the number of seconds since 1 Jan 1970 00:00:00 UTC. The default signing time is the current time. =head2 fudge $fudge = $rr->fudge; $rr->fudge( $fudge ); "fudge" represents the permitted error in the signing time. The default fudge is 300 seconds. =head2 mac $mac = $rr->mac; Returns the message authentication code (MAC) as a string of hex characters. The programmer must call the Net::DNS::Packet data() object method before this will return anything meaningful. =cut =head2 macbin $macbin = $rr->macbin; $rr->macbin( $macbin ); Binary message authentication code (MAC). =head2 prior_mac $prior_mac = $rr->prior_mac; $rr->prior_mac( $prior_mac ); Prior message authentication code (MAC). =head2 prior_macbin $prior_macbin = $rr->prior_macbin; $rr->prior_macbin( $prior_macbin ); Binary prior message authentication code. =head2 request_mac $request_mac = $rr->request_mac; $rr->request_mac( $request_mac ); Request message authentication code (MAC). =head2 request_macbin $request_macbin = $rr->request_macbin; $rr->request_macbin( $request_macbin ); Binary request message authentication code. =head2 original_id $original_id = $rr->original_id; $rr->original_id( $original_id ); The message ID from the header of the original packet. =head2 error =head2 vrfyerrstr $rcode = $tsig->error; Returns the RCODE covering TSIG processing. Common values are NOERROR, BADSIG, BADKEY, and BADTIME. See RFC 2845 for details. =head2 other $other = $tsig->other; This field should be empty unless the error is BADTIME, in which case it will contain the server time as the number of seconds since 1 Jan 1970 00:00:00 UTC. =head2 sig_function sub signing_function { my ( $keybin, $data ) = @_; my $hmac = new Digest::HMAC( $keybin, 'Digest::MD5' ); $hmac->add( $data ); return $hmac->digest; } $tsig->sig_function( \&signing_function ); This sets the signing function to be used for this TSIG record. The default signing function is HMAC-MD5. =head2 sig_data $sigdata = $tsig->sig_data($packet); Returns the packet packed according to RFC2845 in a form for signing. This is only needed if you want to supply an external signing function, such as is needed for TSIG-GSS. =head2 create $tsig = create Net::DNS::RR::TSIG( $keyfile ); $tsig = create Net::DNS::RR::TSIG( $keyfile, fudge => 300 ); Returns a TSIG RR constructed using the parameters in the specified key file, which is assumed to have been generated by dnssec-keygen. $tsig = create Net::DNS::RR::TSIG( $keyname, $key ); The two argument form is supported for backward compatibility. =head2 verify $verify = $tsig->verify( $data ); $verify = $tsig->verify( $packet ); $verify = $tsig->verify( $reply, $query ); $verify = $tsig->verify( $packet, $prior ); The boolean verify method will return true if the hash over the packet data conforms to the data in the TSIG itself =head1 TSIG Keys TSIG keys are symmetric keys generated using dnssec-keygen: $ dnssec-keygen -a HMAC-SHA1 -b 160 -n HOST The key will be stored as a private and public keyfile pair K+161+.private and K+161+.key where is the DNS name of the key. is the (generated) numerical identifier used to distinguish this key. Other algorithms may be substituted for HMAC-SHA1 in the above example. It is recommended that the keyname be globally unique and incorporate the fully qualified domain names of the resolver and nameserver in that order. It should be possible for more than one key to be in use simultaneously between any such pair of hosts. Although the formats differ, the private and public keys are identical and both should be stored and handled as secret data. =head1 Configuring BIND Nameserver The following lines must be added to the /etc/named.conf file: key { algorithm HMAC-SHA1; secret ""; }; is the name of the key chosen when the key was generated. is the key string extracted from the generated key file. =head1 ACKNOWLEDGMENT Most of the code in the Net::DNS::RR::TSIG module was contributed by Chris Turbeville. Support for external signing functions was added by Andrew Tridgell. TSIG verification, BIND keyfile handling and support for HMAC-SHA1, HMAC-SHA224, HMAC-SHA256, HMAC-SHA384 and HMAC-SHA512 functions was added by Dick Franks. =head1 BUGS A 32-bit representation of time is used, contrary to RFC2845 which demands 48 bits. This design decision will need to be reviewed before the code stops working on 7 February 2106. =head1 COPYRIGHT Copyright (c)2000,2001 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. Portions Copyright (c)2013 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC2845, RFC4635 L =cut Net-DNS-1.07/lib/Net/DNS/RR/ISDN.pm0000644000175000017500000000656013031240164015514 0ustar willemwillempackage Net::DNS::RR::ISDN; # # $Id: ISDN.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::ISDN - DNS ISDN resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; ( $self->{address}, $offset ) = decode Net::DNS::Text( $data, $offset ); ( $self->{sa}, $offset ) = decode Net::DNS::Text( $data, $offset ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $address = $self->{address} || return ''; join '', $address->encode, $self->{sa}->encode; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $address = $self->{address} || return ''; join ' ', $address->string, $self->{sa}->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); $self->sa(@_); } sub _defaults { ## specify RR attribute default values my $self = shift; $self->sa(''); } sub address { my $self = shift; $self->{address} = new Net::DNS::Text(shift) if scalar @_; $self->{address}->value if $self->{address}; } sub sa { my $self = shift; $self->{sa} = new Net::DNS::Text(shift) if scalar @_; $self->{sa}->value if $self->{sa}; } sub ISDNaddress { &address; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name ISDN ISDNaddress sa'); =head1 DESCRIPTION Class for DNS ISDN resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 ISDNaddress =head2 address $address = $rr->address; $rr->address( $address ); The ISDN-address is a string of characters, normally decimal digits, beginning with the E.163 country code and ending with the DDI if any. =head2 sa $sa = $rr->sa; $rr->sa( $sa ); The optional subaddress (SA) is a string of hexadecimal digits. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1183 Section 3.2 =cut Net-DNS-1.07/lib/Net/DNS/RR/DLV.pm0000644000175000017500000000403013031240164015372 0ustar willemwillempackage Net::DNS::RR::DLV; # # $Id: DLV.pm 1339 2015-04-16 13:01:17Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1339 $)[1]; use strict; use base qw(Net::DNS::RR::DS); =head1 NAME Net::DNS::RR::DLV - DNS DLV resource record =cut 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name DLV keytag algorithm digtype digest'); =head1 DESCRIPTION DNS DLV resource record This is a clone of the DS record and inherits all properties of the Net::DNS::RR::DS class. Please see the L documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC4431 =cut Net-DNS-1.07/lib/Net/DNS/RR/EUI48.pm0000644000175000017500000000635013031240164015552 0ustar willemwillempackage Net::DNS::RR::EUI48; # # $Id: EUI48.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::EUI48 - DNS EUI48 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a6", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{address}; pack 'a6', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{address}; $self->address; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); } sub address { my ( $self, $address ) = @_; $self->{address} = pack 'C6', map hex($_), split /[:-]/, $address if $address; join '-', unpack 'H2H2H2H2H2H2', $self->{address} if defined wantarray; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN EUI48 address'); $rr = new Net::DNS::RR( name => 'example.com', type => 'EUI48', address => '00-00-5e-00-53-2a' ); =head1 DESCRIPTION DNS resource records for 48-bit Extended Unique Identifier (EUI48). The EUI48 resource record is used to represent IEEE Extended Unique Identifiers used in various layer-2 networks, ethernet for example. EUI48 addresses SHOULD NOT be published in the public DNS. RFC7043 describes potentially severe privacy implications resulting from indiscriminate publication of link-layer addresses in the DNS. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address The address field is a 6-octet layer-2 address in network byte order. The presentation format is hexadecimal separated by "-". =head1 COPYRIGHT Copyright (c)2013 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC7043 =cut Net-DNS-1.07/lib/Net/DNS/RR/EUI64.pm0000644000175000017500000000636213031240164015553 0ustar willemwillempackage Net::DNS::RR::EUI64; # # $Id: EUI64.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::EUI64 - DNS EUI64 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a8", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{address}; pack 'a8', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{address}; $self->address; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); } sub address { my ( $self, $address ) = @_; $self->{address} = pack 'C8', map hex($_), split /[:-]/, $address if $address; join '-', unpack 'H2H2H2H2H2H2H2H2', $self->{address} if defined wantarray; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN EUI64 address'); $rr = new Net::DNS::RR( name => 'example.com', type => 'EUI64', address => '00-00-5e-ef-10-00-00-2a' ); =head1 DESCRIPTION DNS resource records for 64-bit Extended Unique Identifier (EUI64). The EUI64 resource record is used to represent IEEE Extended Unique Identifiers used in various layer-2 networks, ethernet for example. EUI64 addresses SHOULD NOT be published in the public DNS. RFC7043 describes potentially severe privacy implications resulting from indiscriminate publication of link-layer addresses in the DNS. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address The address field is a 8-octet layer-2 address in network byte order. The presentation format is hexadecimal separated by "-". =head1 COPYRIGHT Copyright (c)2013 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC7043 =cut Net-DNS-1.07/lib/Net/DNS/RR/NID.pm0000644000175000017500000000767613031240164015402 0ustar willemwillempackage Net::DNS::RR::NID; # # $Id: NID.pm 1408 2015-10-06 20:35:56Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1408 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NID - DNS NID resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(preference nodeid)} = unpack "\@$offset n a8", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{nodeid}; pack 'n a8', $self->{preference}, $self->{nodeid}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{nodeid}; return join ' ', $self->preference, $self->nodeid; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->nodeid(shift); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub nodeid { my $self = shift; my $idnt = shift; $self->{nodeid} = pack 'n4', map hex($_), split /:/, $idnt if defined $idnt; sprintf '%0.4x:%0.4x:%0.4x:%0.4x', unpack 'n4', $self->{nodeid} if $self->{nodeid}; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN NID preference nodeid'); $rr = new Net::DNS::RR( name => 'example.com', type => 'NID', preference => 10, nodeid => '8:800:200C:417A' ); =head1 DESCRIPTION Class for DNS Node Identifier (NID) resource records. The Node Identifier (NID) DNS resource record is used to hold values for Node Identifiers that will be used for ILNP-capable nodes. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this NID record among other NID records associated with this owner name. Lower values are preferred over higher values. =head2 nodeid $nodeid = $rr->nodeid; The NodeID field is an unsigned 64-bit value in network byte order. The text representation uses the same syntax (i.e., groups of 4 hexadecimal digits separated by a colons) that is already used for IPv6 interface identifiers. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6742 =cut Net-DNS-1.07/lib/Net/DNS/RR/HIP.pm0000644000175000017500000001215513031240164015374 0ustar willemwillempackage Net::DNS::RR::HIP; # # $Id: HIP.pm 1512 2016-10-26 09:14:27Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1512 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::HIP - DNS HIP resource record =cut use integer; use Carp; use Net::DNS::DomainName; use MIME::Base64; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my ( $hitlen, $pklen ) = unpack "\@$offset Cxn", $$data; @{$self}{qw(pkalgorithm hitbin keybin)} = unpack "\@$offset xCxx a$hitlen a$pklen", $$data; my $limit = $offset + $self->{rdlength}; $offset += 4 + $hitlen + $pklen; $self->{servers} = []; while ( $offset < $limit ) { my $item; ( $item, $offset ) = decode Net::DNS::DomainName( $data, $offset ); push @{$self->{servers}}, $item; } croak('corrupt HIP data') unless $offset == $limit; # more or less FUBAR } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{hitbin}; my $hit = $self->hitbin; my $key = $self->keybin; my $nos = pack 'C2n a* a*', length($hit), $self->pkalgorithm, length($key), $hit, $key; join '', $nos, map $_->encode, @{$self->{servers}}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{hitbin}; my $base64 = encode_base64( $self->keybin, '' ); my @server = map $_->string, @{$self->{servers}}; my @rdata = ( $self->pkalgorithm, $self->hit, $base64, @server ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(pkalgorithm hit key)) { $self->$_(shift) } $self->servers(@_); } sub pkalgorithm { my $self = shift; $self->{pkalgorithm} = 0 + shift if scalar @_; $self->{pkalgorithm} || 0; } sub hit { my $self = shift; $self->hitbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->hitbin() if defined wantarray; } sub hitbin { my $self = shift; $self->{hitbin} = shift if scalar @_; $self->{hitbin} || ""; } sub key { my $self = shift; $self->keybin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->keybin(), "" ) if defined wantarray; } sub keybin { my $self = shift; $self->{keybin} = shift if scalar @_; $self->{keybin} || ""; } sub pubkey { &key; } sub servers { my $self = shift; my $servers = $self->{servers} ||= []; @$servers = map Net::DNS::DomainName->new($_), @_ if scalar @_; return map $_->name, @$servers if defined wantarray; } sub rendezvousservers { ## historical my @servers = &servers; # uncoverable pod \@servers; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN HIP algorithm hit key servers'); =head1 DESCRIPTION Class for DNS Host Identity Protocol (HIP) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 pkalgorithm $pkalgorithm = $rr->pkalgorithm; $rr->pkalgorithm( $pkalgorithm ); The PK algorithm field indicates the public key cryptographic algorithm and the implied public key field format. The values are those defined for the IPSECKEY algorithm type [RFC4025]. =head2 hit $hit = $rr->hit; $rr->hit( $hit ); The hexadecimal representation of the host identity tag. =head2 hitbin $hitbin = $rr->hitbin; $rr->hitbin( $hitbin ); The binary representation of the host identity tag. =head2 pubkey =head2 key $key = $rr->key; $rr->key( $key ); The hexadecimal representation of the public key. =head2 keybin $keybin = $rr->keybin; $rr->keybin( $keybin ); The binary representation of the public key. =head2 servers @servers = $rr->servers; Optional list of domain names of rendezvous servers. =head1 COPYRIGHT Copyright (c)2009 Olaf Kolkman, NLnet Labs All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC8005 =cut Net-DNS-1.07/lib/Net/DNS/RR/CDS.pm0000644000175000017500000000436413031240164015370 0ustar willemwillempackage Net::DNS::RR::CDS; # # $Id: CDS.pm 1517 2016-11-17 06:11:17Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1517 $)[1]; use strict; use base qw(Net::DNS::RR::DS); =head1 NAME Net::DNS::RR::CDS - DNS CDS resource record =cut sub digtype { ## CDS differs from DS by allowing digtype(0) my $self = shift; my ($arg) = @_; return $self->{digtype} unless defined $arg; return $arg ? $self->SUPER::digtype(@_) : ( $self->{digtype} = 0 ); } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name CDS keytag algorithm digtype digest'); =head1 DESCRIPTION DNS Child DS resource record This is a clone of the DS record and inherits all properties of the Net::DNS::RR::DS class. Please see the L perl documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2014,2016 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC7344 =cut Net-DNS-1.07/lib/Net/DNS/RR/NSEC.pm0000644000175000017500000001134013031240164015477 0ustar willemwillempackage Net::DNS::RR::NSEC; # # $Id: NSEC.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NSEC - DNS NSEC resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Parameters; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{nxtdname}, $offset ) = decode Net::DNS::DomainName(@_); $self->{typebm} = substr $$data, $offset, $limit - $offset; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $nxtdname = $self->{nxtdname} || return ''; join '', $nxtdname->encode(), $self->{typebm}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $nxtdname = $self->{nxtdname} || return ''; my @rdata = ( $nxtdname->string(), $self->typelist ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->nxtdname(shift); $self->typelist(@_); } sub nxtdname { my $self = shift; $self->{nxtdname} = new Net::DNS::DomainName(shift) if scalar @_; $self->{nxtdname}->name if $self->{nxtdname}; } sub typelist { my $self = shift; $self->{typebm} = &_type2bm if scalar @_; my @type = defined wantarray ? &_bm2type( $self->{typebm} ) : (); return wantarray ? (@type) : "@type"; } ######################################## sub _type2bm { my @typearray; foreach my $typename ( map split(), @_ ) { my $number = typebyname($typename); my $window = $number >> 8; my $bitnum = $number & 255; my $octet = $bitnum >> 3; my $bit = $bitnum & 7; $typearray[$window][$octet] |= 0x80 >> $bit; } my $bitmap = ''; my $window = 0; foreach (@typearray) { if ( my $pane = $typearray[$window] ) { my @content = map $_ || 0, @$pane; $bitmap .= pack 'CC C*', $window, scalar(@content), @content; } $window++; } return $bitmap; } sub _bm2type { my @typelist; my $bitmap = shift || return @typelist; my $index = 0; my $limit = length $bitmap; while ( $index < $limit ) { my ( $block, $size ) = unpack "\@$index C2", $bitmap; my $typenum = $block << 8; foreach my $octet ( unpack "\@$index xxC$size", $bitmap ) { my $i = $typenum += 8; my @name; while ($octet) { --$i; unshift @name, typebyval($i) if $octet & 1; $octet = $octet >> 1; } push @typelist, @name; } $index += $size + 2; } return @typelist; } sub typebm { ## historical my $self = shift; # uncoverable pod $self->{typebm} = shift if scalar @_; return $self->{typebm}; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name NSEC nxtdname typelist'); =head1 DESCRIPTION Class for DNSSEC NSEC resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 nxtdname $nxtdname = $rr->nxtdname; $rr->nxtdname( $nxtdname ); The Next Domain field contains the next owner name (in the canonical ordering of the zone) that has authoritative data or contains a delegation point NS RRset. =head2 typelist @typelist = $rr->typelist; $typelist = $rr->typelist; The Type List identifies the RRset types that exist at the NSEC RR owner name. When called in scalar context, the list is interpolated into a string. =head1 COPYRIGHT Copyright (c)2001-2005 RIPE NCC. Author Olaf M. Kolkman All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC4034, RFC3755 =cut Net-DNS-1.07/lib/Net/DNS/RR/KEY.pm0000644000175000017500000000430713031240164015404 0ustar willemwillempackage Net::DNS::RR::KEY; # # $Id: KEY.pm 1381 2015-08-25 07:36:09Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1381 $)[1]; use strict; use base qw(Net::DNS::RR::DNSKEY); =head1 NAME Net::DNS::RR::KEY - DNS KEY resource record =cut sub _defaults { ## specify RR attribute default values my $self = shift; $self->algorithm(1); $self->flags(0); $self->protocol(3); } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name KEY flags protocol algorithm publickey'); =head1 DESCRIPTION DNS KEY resource record This is a clone of the DNSKEY record and inherits all properties of the Net::DNS::RR::DNSKEY class. Please see the L documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC3755, RFC2535 =cut Net-DNS-1.07/lib/Net/DNS/RR/SIG.pm0000644000175000017500000005233513031240164015402 0ustar willemwillem # pre-5.14.0 perl inadvertently destroys signal handlers # http://rt.perl.org/rt3/Public/Bug/Display.html?id=76138 # BEGIN { ## capture %SIG before compilation use constant RT_76138 => $] < 5.014; @::SIG_BACKUP = %SIG if RT_76138; } sub UNITCHECK { ## restore %SIG after compilation %SIG = @::SIG_BACKUP if RT_76138; } package Net::DNS::RR::SIG; # # $Id: SIG.pm 1505 2016-09-17 08:12:15Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1505 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SIG - DNS SIG resource record =cut use integer; use Carp; use Time::Local; eval 'require MIME::Base64'; use Net::DNS::Parameters; use constant DEBUG => 0; use constant UTIL => defined eval 'use Scalar::Util 1.24; 1;'; use constant PRIVATE => defined eval 'require Net::DNS::SEC::Private'; use constant DSA => defined eval 'require Net::DNS::SEC::DSA'; use constant RSA => defined eval 'require Net::DNS::SEC::RSA'; use constant DNSSEC => PRIVATE && ( RSA || DSA ); my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{@field} = unpack "\@$offset n C2 N3 n", $$data; ( $self->{signame}, $offset ) = decode Net::DNS::DomainName2535( $data, $offset + 18 ); $self->{sigbin} = substr $$data, $offset, $limit - $offset; croak('misplaced or corrupt SIG') unless $limit == length $$data; my $raw = substr $$data, 0, $self->{offset}; $self->{rawref} = \$raw; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my ( $hash, $packet ) = @opaque; my $signame = $self->{signame} || return ''; if ( DNSSEC && !$self->{sigbin} ) { my $private = $self->{private} || die 'missing key reference'; delete $self->{private}; # one shot is all you get my $sigdata = $self->_CreateSigData($packet); $self->_CreateSig( $sigdata, $private ); } pack 'n C2 N3 n a* a*', @{$self}{@field}, $signame->encode, $self->sigbin; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @sig64 = split /\s+/, MIME::Base64::encode( $self->sigbin ); my @rdata = ( map( $self->$_, @field ), $self->{signame}->string, @sig64 ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach ( @field, qw(signame) ) { $self->$_(shift) } $self->signature(@_); } sub _defaults { ## specify RR attribute default values my $self = shift; $self->class('ANY'); $self->typecovered('TYPE0'); $self->algorithm(1); $self->labels(0); $self->orgttl(0); $self->sigval(10); } # # source: http://www.iana.org/assignments/dns-sec-alg-numbers # { my @algbyname = ( ## Reserved => 0, # [RFC4034][RFC4398] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; my $map = sub { my $arg = shift; return $arg if $arg =~ /^\d/; $arg =~ s/[^A-Za-z0-9]//g; # strip non-alphanumerics uc($arg); }; my @pairedval = sort ( 1 .. 254, 1 .. 254 ); # also accept number my %algbyname = map &$map($_), @algbyname, @pairedval; sub _algbyname { my $name = shift; my $key = uc $name; # synthetic key $key =~ s/[^A-Z0-9]//g; # strip non-alphanumerics $algbyname{$key} || croak "unknown algorithm $name"; } sub _algbyval { my $value = shift; $algbyval{$value} || return $value; } } my $DSA = DSA ? 'Net::DNS::SEC::DSA' : 0; my $RSA = RSA ? 'Net::DNS::SEC::RSA' : 0; my %SEC = ( 1 => $RSA, 3 => $DSA, 5 => $RSA, 6 => $DSA, 7 => $RSA, ); my %siglen = ( 1 => 128, 3 => 41, 5 => 256, 6 => 41, 7 => 256, 8 => 256, 10 => 256, 12 => 64, 13 => 64, 14 => 96, ); sub _size { ## estimate encoded size my $self = shift; my $clone = bless {%$self}, ref($self); # shallow clone $clone->sigbin( 'x' x $siglen{$self->algorithm} ); length $clone->encode(); } sub typecovered { my $self = shift; # uncoverable pod $self->{typecovered} = typebyname(shift) if scalar @_; my $typecode = $self->{typecovered}; typebyval($typecode) if defined wantarray && defined $typecode; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _algbyname($arg); } sub labels { shift->{labels} = 0; # uncoverable pod } sub orgttl { shift->{orgttl} = 0; # uncoverable pod } sub sigexpiration { my $self = shift; $self->{sigexpiration} = _string2time(shift) if scalar @_; my $time = $self->{sigexpiration}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub siginception { my $self = shift; $self->{siginception} = _string2time(shift) if scalar @_; my $time = $self->{siginception}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub sigex { &sigexpiration; } ## historical sub sigin { &siginception; } ## historical sub sigval { my $self = shift; no integer; ( $self->{sigval} ) = map int( 60.0 * $_ ), @_; } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; $self->{keytag} || 0; } sub signame { my $self = shift; $self->{signame} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{signame}->name if $self->{signame}; } sub sig { my $self = shift; $self->sigbin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->sigbin(), "" ) if defined wantarray; } sub sigbin { my $self = shift; $self->{sigbin} = shift if scalar @_; $self->{sigbin} || ""; } sub signature { &sig; } sub create { unless (DNSSEC) { croak 'Net::DNS::SEC support not available'; } else { my ( $class, $data, $priv_key, %etc ) = @_; my $private = ref($priv_key) ? $priv_key : Net::DNS::SEC::Private->new($priv_key); croak 'Unable to parse private key' unless ref($private) eq 'Net::DNS::SEC::Private'; my $self = new Net::DNS::RR( type => 'SIG', typecovered => 'TYPE0', siginception => time(), algorithm => $private->algorithm, keytag => $private->keytag, signame => $private->signame, ); while ( my ( $attribute, $value ) = each %etc ) { $self->$attribute($value); } $self->{sigexpiration} = $self->{siginception} + $self->{sigval} unless $self->{sigexpiration}; $self->_CreateSig( $self->_CreateSigData($data), $private ) if $data; $self->{private} = $private unless $data; # mark packet for SIG0 generation return $self; } } sub verify { # Reminder... # $dataref may be either a data string or a reference to a # Net::DNS::Packet object. # # $keyref is either a key object or a reference to an array # of keys. if (DNSSEC) { my ( $self, $dataref, $keyref ) = @_; if ( my $isa = ref($dataref) ) { print '$dataref argument is ', $isa, "\n" if DEBUG; croak '$dataref can not be ', $isa unless $isa =~ /^Net::DNS::/; croak '$dataref can not be ', $isa unless $dataref->isa('Net::DNS::Packet'); } print '$keyref argument is of class ', ref($keyref), "\n" if DEBUG; if ( ref($keyref) eq "ARRAY" ) { # We will recurse for each key that matches algorithm and key-id # and return when there is a successful verification. # If not, we'll continue so that we even survive key-id collision. # The downside of this is that the error string only matches the # last error. print "Iterating over ", scalar(@$keyref), " keys\n" if DEBUG; my @error; my $i; foreach my $keyrr (@$keyref) { my $result = $self->verify( $dataref, $keyrr ); return $result if $result; my $error = $self->{vrfyerrstr}; $i++; push @error, "key $i: $error"; print "key $i: $error\n" if DEBUG; next; } $self->{vrfyerrstr} = join "\n", @error; return 0; } elsif ( $keyref->isa('Net::DNS::RR::DNSKEY') ) { print "Validating using key with keytag: ", $keyref->keytag, "\n" if DEBUG; } else { croak join ' ', ref($keyref), 'can not be used as SIG0 key'; } if (DEBUG) { print "\n ---------------------- SIG DEBUG ----------------------"; print "\n SIG:\t", $self->string; print "\n KEY:\t", $keyref->string; print "\n -------------------------------------------------------\n"; } croak "Trying to verify SIG0 using non-SIG0 signature" if $self->{typecovered}; $self->{vrfyerrstr} = ''; unless ( $self->algorithm == $keyref->algorithm ) { $self->{vrfyerrstr} = 'algorithm does not match'; return 0; } unless ( $self->keytag == $keyref->keytag ) { $self->{vrfyerrstr} = 'keytag does not match'; return 0; } # The data that is to be verified my $sigdata = $self->_CreateSigData($dataref); my $verified = $self->_VerifySig( $sigdata, $keyref ) || return 0; # time to do some time checking. my $t = time; if ( _ordered( $self->{sigexpiration}, $t ) ) { $self->{vrfyerrstr} = join ' ', 'Signature expired at', $self->sigexpiration; return 0; } elsif ( _ordered( $t, $self->{siginception} ) ) { $self->{vrfyerrstr} = join ' ', 'Signature valid from', $self->siginception; return 0; } return 1; } } #END verify sub vrfyerrstr { shift->{vrfyerrstr}; } ######################################## sub _ordered($$) { ## irreflexive 32-bit partial ordering use integer; my ( $a, $b ) = @_; return defined $b unless defined $a; # ( undef, any ) return 0 unless defined $b; # ( any, undef ) # unwise to assume 32-bit arithmetic, or that integer overflow goes unpunished if ( $a < 0 ) { # translate $a<0 region $a = ( $a ^ 0x80000000 ) & 0xFFFFFFFF; # 0 <= $a < 2**31 $b = ( $b ^ 0x80000000 ) & 0xFFFFFFFF; # -2**31 <= $b < 2**32 } return $a < $b ? ( $a > ( $b - 0x80000000 ) ) : ( $b < ( $a - 0x80000000 ) ); } my $y1998 = timegm( 0, 0, 0, 1, 0, 1998 ); my $y2026 = timegm( 0, 0, 0, 1, 0, 2026 ); my $y2082 = $y2026 << 1; my $y2054 = $y2082 - $y1998; my $m2026 = int( 0x80000000 - $y2026 ); my $m2054 = int( 0x80000000 - $y2054 ); my $t2082 = int( $y2082 & 0x7FFFFFFF ); my $t2100 = 1960058752; sub _string2time { ## parse time specification string my $arg = shift; croak 'undefined time' unless defined $arg; return int($arg) if length($arg) < 12; my ( $y, $m, @dhms ) = unpack 'a4 a2 a2 a2 a2 a2', $arg . '00'; unless ( $arg gt '20380119031407' ) { # calendar folding return timegm( reverse(@dhms), $m - 1, $y ) if $y < 2026; return timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2026; } elsif ( $y > 2082 ) { my $z = timegm( reverse(@dhms), $m - 1, $y - 84 ); $z -= 86400 unless $z < 1456704000 + 86400; # expunge 29 Feb 2100 return $z + $y2054; } return ( timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2054 ) - $y1998; } sub _time2string { ## format time specification string my $arg = shift; croak 'undefined time' unless defined $arg; my $ls31 = int( $arg & 0x7FFFFFFF ); if ( $arg & 0x80000000 ) { if ( $ls31 > $t2082 ) { $ls31 += 86400 unless $ls31 < $t2100; # expunge 29 Feb 2100 my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2054 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1984, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } elsif ( $ls31 > $y2026 ) { my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 - $y2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime $ls31 )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1900, $mm + 1, @dhms; } sub _CreateSigData { if (DNSSEC) { my ( $self, $message ) = @_; if ( ref($message) ) { die 'missing packet reference' unless $message->isa('Net::DNS::Packet'); my @unsigned = grep ref($_) ne ref($self), @{$message->{additional}}; local $message->{additional} = \@unsigned; # remake header image my @part = qw(question answer authority additional); my @size = map scalar( @{$message->{$_}} ), @part; my $rref = $self->{rawref}; delete $self->{rawref}; my $data = $rref ? $$rref : $message->data; my ( $id, $status ) = unpack 'n2', $data; my $hbin = pack 'n6 a*', $id, $status, @size; $message = $hbin . substr $data, length $hbin; } my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); my $sigdata = pack 'n C2 N3 n a*', @{$self}{@field}, $self->{signame}->encode; print "\npreamble\t", unpack( 'H*', $sigdata ), "\nrawdata\t", unpack( 'H100', $message ), " ...\n" if DEBUG; join '', $sigdata, $message; } } ######################################## sub _CreateSig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $SEC{$algorithm}; eval { die "algorithm $algorithm not supported" unless $class; $self->sigbin( $class->sign(@_) ); } || croak "${@}signature generation failed"; } } sub _VerifySig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $SEC{$algorithm}; my $retval = eval { die "algorithm $algorithm not supported" unless $class; $class->verify( @_, $self->sigbin ); }; unless ($retval) { $self->{vrfyerrstr} = "${@}signature verification failed"; print "\n", $self->{vrfyerrstr}, "\n" if DEBUG; return 0; } # uncoverable branch true # bug in Net::DNS::SEC or dependencies croak "unknown error in $class->verify" unless $retval == 1; print "\nalgorithm $algorithm verification successful\n" if DEBUG; return 1; } } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name SIG typecovered algorithm labels orgttl sigexpiration siginception keytag signame signature'); use Net::DNS::SEC; $sigrr = create Net::DNS::RR::SIG( $string, $keypath, sigval => 10 # minutes ); $sigrr->verify( $string, $keyrr ) || die $sigrr->vrfyerrstr; $sigrr->verify( $packet, $keyrr ) || die $sigrr->vrfyerrstr; =head1 DESCRIPTION Class for DNS digital signature (SIG) resource records. In addition to the regular methods inherited from Net::DNS::RR the class contains a method to sign packets and scalar data strings using private keys (create) and a method for verifying signatures. The SIG RR is an implementation of RFC2931. See L for an implementation of RFC4034. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; The algorithm number field identifies the cryptographic algorithm used to create the signature. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 sigexpiration and siginception times =head2 sigex sigin sigval $expiration = $rr->sigexpiration; $expiration = $rr->sigexpiration( $value ); $inception = $rr->siginception; $inception = $rr->siginception( $value ); The signature expiration and inception fields specify a validity time interval for the signature. The value may be specified by a string with format 'yyyymmddhhmmss' or a Perl time() value. Return values are dual-valued, providing either a string value or numerical Perl time() value. =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); The keytag field contains the key tag value of the KEY RR that validates this signature. =head2 signame $signame = $rr->signame; $rr->signame( $signame ); The signer name field value identifies the owner name of the KEY RR that a validator is supposed to use to validate this signature. =head2 signature =head2 sig $sig = $rr->sig; $rr->sig( $sig ); The Signature field contains the cryptographic signature that covers the SIG RDATA (excluding the Signature field) and the subject data. =head2 sigbin $sigbin = $rr->sigbin; $rr->sigbin( $sigbin ); Binary representation of the cryptographic signature. =head2 create Create a signature over scalar data. use Net::DNS::SEC; $keypath = '/home/olaf/keys/Kbla.foo.+001+60114.private'; $sigrr = create Net::DNS::RR::SIG( $data, $keypath ); $sigrr = create Net::DNS::RR::SIG( $data, $keypath, sigval => 10 ); $sigrr->print; # Alternatively use Net::DNS::SEC::Private $private = Net::DNS::SEC::Private->new($keypath); $sigrr= create Net::DNS::RR::SIG( $data, $private ); create() is an alternative constructor for a SIG RR object. This method returns a SIG with the signature over the data made with the private key stored in the key file. The first argument is a scalar that contains the data to be signed. The second argument is a string which specifies the path to a file containing the private key as generated with dnssec-keygen, a program that comes with the ISC BIND distribution. The optional remaining arguments consist of ( name => value ) pairs as follows: sigin => 20161201010101, # signature inception sigex => 20161201011101, # signature expiration sigval => 10, # validity window (minutes) The sigin and sigex values may be specified as Perl time values or as a string with the format 'yyyymmddhhmmss'. The default for sigin is the time of signing. The sigval argument specifies the signature validity window in minutes ( sigex = sigin + sigval ). By default the signature is valid for 10 minutes. =over 4 =item * Do not change the name of the file generated by dnssec-keygen, the create method uses the filename as generated by dnssec-keygen to determine the keyowner, algorithm and the keyid (keytag). =back =head2 verify $verify = $sigrr->verify( $data, $keyrr ); $verify = $sigrr->verify( $data, [$keyrr, $keyrr2, $keyrr3] ); The verify() method performs SIG0 verification of the specified data against the signature contained in the $sigrr object itself using the public key in $keyrr. If a reference to a Net::DNS::Packet is supplied, the method performs a SIG0 verification on the packet data. The second argument can either be a Net::DNS::RR::KEYRR object or a reference to an array of such objects. Verification will return successful as soon as one of the keys in the array leads to positive validation. Returns false on error and sets $sig->vrfyerrstr =head2 vrfyerrstr $sig0 = $packet->sigrr || die 'not signed'; print $sig0->vrfyerrstr unless $sig0->verify( $packet, $keyrr ); $sigrr->verify( $packet, $keyrr ) || die $sigrr->vrfyerrstr; =head1 REMARKS The code is not optimised for speed. If this code is still around in 2100 (not a leap year) you will need to check for proper handling of times ... =head1 ACKNOWLEDGMENTS Andy Vaskys (Network Associates Laboratories) supplied the code for handling RSA with SHA1 (Algorithm 5). T.J. Mather, the Crypt::OpenSSL::DSA maintainer, for his quick responses to bug report and feature requests. =head1 COPYRIGHT Copyright (c)2001-2005 RIPE NCC, Olaf M. Kolkman Copyright (c)2007-2008 NLnet Labs, Olaf M. Kolkman Portions Copyright (c)2014 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC4034, RFC3755, RFC2535, RFC2931, RFC3110, RFC3008, L, L L L =cut Net-DNS-1.07/lib/Net/DNS/RR/NSEC3PARAM.pm0000644000175000017500000001147213031240164016351 0ustar willemwillempackage Net::DNS::RR::NSEC3PARAM; # # $Id: NSEC3PARAM.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NSEC3PARAM - DNS NSEC3PARAM resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $size = unpack "\@$offset x4 C", $$data; @{$self}{qw(algorithm flags iterations saltbin)} = unpack "\@$offset CCnx a$size", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{algorithm}; my $salt = $self->saltbin; pack 'CCnCa*', @{$self}{qw(algorithm flags iterations)}, length($salt), $salt; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{algorithm}; join ' ', $self->algorithm, $self->flags, $self->iterations, $self->salt || '-'; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->algorithm(shift); $self->flags(shift); $self->iterations(shift); my $salt = shift; $self->salt($salt) unless $salt eq '-'; } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; $self->{algorithm} || 0; } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; $self->{flags} || 0; } sub iterations { my $self = shift; $self->{iterations} = 0 + shift if scalar @_; $self->{iterations} || 0; } sub salt { my $self = shift; $self->saltbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->saltbin() if defined wantarray; } sub saltbin { my $self = shift; $self->{saltbin} = shift if scalar @_; $self->{saltbin} || ""; } ######################################## sub hashalgo { &algorithm; } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name NSEC3PARAM algorithm flags iterations salt'); =head1 DESCRIPTION Class for DNSSEC NSEC3PARAM resource records. The NSEC3PARAM RR contains the NSEC3 parameters (hash algorithm, flags, iterations and salt) needed to calculate hashed ownernames. The presence of an NSEC3PARAM RR at a zone apex indicates that the specified parameters may be used by authoritative servers to choose an appropriate set of NSEC3 records for negative responses. The NSEC3PARAM RR is not used by validators or resolvers. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The Hash Algorithm field is represented as an unsigned decimal integer. The value has a maximum of 255. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); The Flags field is represented as an unsigned decimal integer. The value has a maximum of 255. =head2 iterations $iterations = $rr->iterations; $rr->iterations( $iterations ); The Iterations field is represented as an unsigned decimal integer. The value is between 0 and 65535, inclusive. =head2 salt $salt = $rr->salt; $rr->salt( $salt ); The Salt field is represented as a contiguous sequence of hexadecimal digits. A "-" (unquoted) is used in string format to indicate that the salt field is absent. =head2 saltbin $saltbin = $rr->saltbin; $rr->saltbin( $saltbin ); The Salt field as a sequence of octets. =head1 COPYRIGHT Copyright (c)2007,2008 NLnet Labs. Author Olaf M. Kolkman All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC5155 =cut Net-DNS-1.07/lib/Net/DNS/RR/TKEY.pm0000644000175000017500000001266413031240164015535 0ustar willemwillempackage Net::DNS::RR::TKEY; # # $Id: TKEY.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::TKEY - DNS TKEY resource record =cut use integer; use Carp; use Net::DNS::Parameters; use Net::DNS::DomainName; use constant ANY => classbyname qw(ANY); use constant TKEY => typebyname qw(TKEY); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{algorithm}, $offset ) = decode Net::DNS::DomainName(@_); @{$self}{qw(inception expiration mode error)} = unpack "\@$offset N2n2", $$data; $offset += 12; my $key_size = unpack "\@$offset n", $$data; $self->{key} = substr $$data, $offset + 2, $key_size; $offset += $key_size + 2; my $other_size = unpack "\@$offset n", $$data; $self->{other} = substr $$data, $offset + 2, $other_size; $offset += $other_size + 2; croak('corrupt TKEY data') unless $offset == $limit; # more or less FUBAR } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{algorithm}; my $rdata = $self->{algorithm}->encode; $rdata .= pack 'N2n2', $self->inception, $self->expiration, $self->mode, $self->error; my $key = $self->key; # RFC2930(2.7) $rdata .= pack 'na*', length $key, $key; my $other = $self->other; # RFC2930(2.8) $rdata .= pack 'na*', length $other, $other; return $rdata; } sub class { ## overide RR method return 'ANY'; } sub encode { ## overide RR method my $self = shift; my $owner = $self->{owner}->encode(); my $rdata = eval { $self->_encode_rdata() } || ''; return pack 'a* n2 N n a*', $owner, TKEY, ANY, 0, length $rdata, $rdata; } sub algorithm { my $self = shift; $self->{algorithm} = new Net::DNS::DomainName(shift) if scalar @_; $self->{algorithm}->name if $self->{algorithm}; } sub inception { my $self = shift; $self->{inception} = 0 + shift if scalar @_; $self->{inception} || 0; } sub expiration { my $self = shift; $self->{expiration} = 0 + shift if scalar @_; $self->{expiration} || 0; } sub mode { my $self = shift; $self->{mode} = 0 + shift if scalar @_; $self->{mode} || 0; } sub error { my $self = shift; $self->{error} = 0 + shift if scalar @_; $self->{error} || 0; } sub key { my $self = shift; $self->{key} = shift if scalar @_; $self->{key} || ""; } sub other { my $self = shift; $self->{other} = shift if scalar @_; $self->{other} || ""; } sub other_data { &other; } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; =head1 DESCRIPTION Class for DNS TSIG Key (TKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The algorithm name is in the form of a domain name with the same meaning as in [RFC 2845]. The algorithm determines how the secret keying material agreed to using the TKEY RR is actually used to derive the algorithm specific key. =head2 inception $inception = $rr->inception; $rr->inception( $inception ); Time expressed as the number of non-leap seconds modulo 2**32 since the beginning of January 1970 GMT. =head2 expiration $expiration = $rr->expiration; $rr->expiration( $expiration ); Time expressed as the number of non-leap seconds modulo 2**32 since the beginning of January 1970 GMT. =head2 mode $mode = $rr->mode; $rr->mode( $mode ); The mode field specifies the general scheme for key agreement or the purpose of the TKEY DNS message, as defined in [RFC2930(2.5)]. =head2 error $error = $rr->error; $rr->error( $error ); The error code field is an extended RCODE. =head2 key $key = $rr->key; $rr->key( $key ); Sequence of octets representing the key exchange data. The meaning of this data depends on the mode. =head2 other $other = $rr->other; $rr->other( $other ); Content not defined in the [RFC2930] specification but may be used in future extensions. =head1 COPYRIGHT Copyright (c)2000 Andrew Tridgell. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC2930 =cut Net-DNS-1.07/lib/Net/DNS/RR/A.pm0000644000175000017500000000600113031240164015125 0ustar willemwillempackage Net::DNS::RR::A; # # $Id: A.pm 1388 2015-09-07 12:28:16Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1388 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::A - DNS A resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a4", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{address}; pack 'a4', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{address}; $self->address; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); } my $pad = pack 'x4'; sub address { my $self = shift; my $addr = shift; return join '.', unpack 'C4', $self->{address} . $pad unless defined $addr; # Note: pack masks overlarge values, mostly without warning my @part = split /\./, $addr; my $last = pop(@part); $self->{address} = pack 'C4', @part, (0) x ( 3 - @part ), $last; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN A address'); $rr = new Net::DNS::RR( name => 'example.com', type => 'A', address => '192.0.2.1' ); =head1 DESCRIPTION Class for DNS Address (A) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address $IPv4_address = $rr->address; $rr->address( $IPv4_address ); Version 4 IP address represented using dotted-quad notation. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 3.4.1 =cut Net-DNS-1.07/lib/Net/DNS/RR/SPF.pm0000644000175000017500000000525113031240164015403 0ustar willemwillempackage Net::DNS::RR::SPF; # # $Id: SPF.pm 1382 2015-08-26 20:39:33Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1382 $)[1]; use strict; use base qw(Net::DNS::RR::TXT); =head1 NAME Net::DNS::RR::SPF - DNS SPF resource record =cut use integer; sub spfdata { my @spf = shift->char_str_list(@_); wantarray ? @spf : join '', @spf; } sub txtdata { &spfdata; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name SPF spfdata ...'); $rr = new Net::DNS::RR( name => 'name', type => 'SPF', spfdata => 'single text string' ); $rr = new Net::DNS::RR( name => 'name', type => 'SPF', spfdata => [ 'multiple', 'strings', ... ] ); =head1 DESCRIPTION Class for DNS Sender Policy Framework (SPF) resource records. SPF records inherit most of the properties of the Net::DNS::RR::TXT class. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 spfdata =head2 txtdata $string = $rr->spfdata; @list = $rr->spfdata; $rr->spfdata( @list ); When invoked in scalar context, spfdata() returns the policy text as a single string, with text elements concatenated without intervening spaces. In a list context, spfdata() returns a list of the text elements. =head1 COPYRIGHT Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC4408 =cut Net-DNS-1.07/lib/Net/DNS/RR/DS.pm0000644000175000017500000002371613031240164015267 0ustar willemwillempackage Net::DNS::RR::DS; # # $Id: DS.pm 1488 2016-06-07 09:04:50Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1488 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DS - DNS DS resource record =cut use integer; use Carp; use constant BABBLE => defined eval 'require Digest::BubbleBabble'; eval 'require Digest::SHA'; ## optional for simple Net::DNS RR eval 'require Digest::GOST'; eval 'require Digest::GOST::CryptoPro'; my %digest = ( '1' => ['Digest::SHA', 1], '2' => ['Digest::SHA', 256], '3' => ['Digest::GOST::CryptoPro'], '4' => ['Digest::SHA', 384], ); # # source: http://www.iana.org/assignments/dns-sec-alg-numbers # { my @algbyname = ( ## Reserved => 0, # [RFC4034][RFC4398] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; my $map = sub { my $arg = shift; return $arg if $arg =~ /^\d/; $arg =~ s/[^A-Za-z0-9]//g; # strip non-alphanumerics uc($arg); }; my @pairedval = sort ( 1 .. 254, 1 .. 254 ); # also accept number my %algbyname = map &$map($_), @algbyname, @pairedval; sub _algbyname { my $name = shift; my $key = uc $name; # synthetic key $key =~ s/[^A-Z0-9]//g; # strip non-alphanumerics $algbyname{$key} || croak "unknown algorithm $name"; } sub _algbyval { my $value = shift; $algbyval{$value} || return $value; } } # # source: http://www.iana.org/assignments/ds-rr-types # { my @digestbyname = ( 'SHA-1' => 1, # RFC3658 'SHA-256' => 2, # RFC4509 'GOST' => 3, # RFC5933 'SHA-384' => 4, # RFC6605 ); my @digestbyalias = ( 'SHA' => 1 ); my %digestbyval = reverse @digestbyname; my $map = sub { my $arg = shift; unless ( $digestbyval{$arg} ) { $arg =~ s/[^A-Za-z0-9]//g; # synthetic key return uc $arg; } my @map = ( $arg, "$arg" => $arg ); # also accept number }; my %digestbyname = map &$map($_), @digestbyalias, @digestbyname; sub _digestbyname { my $name = shift; my $key = uc $name; # synthetic key $key =~ s /[^A-Z0-9]//g; # strip non-alphanumerics $digestbyname{$key} || croak "unknown digest type $name"; } sub _digestbyval { my $value = shift; $digestbyval{$value} || return $value; } } sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $length = $self->{rdlength} - 4; @{$self}{qw(keytag algorithm digtype digestbin)} = unpack "\@$offset n C2 a$length", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{digestbin}; pack 'n C2 a*', @{$self}{qw(keytag algorithm digtype digestbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{digestbin}; $self->_annotation( $self->babble ) if BABBLE; my @digest = split /(\S{64})/, $self->digest; my @rdata = ( @{$self}{qw(keytag algorithm digtype)}, @digest ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(keytag algorithm digtype)) { $self->$_(shift) } $self->digest(@_); } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; $self->{keytag} || 0; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _algbyname($arg); } sub digtype { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _digestbyname($argn) : _digestbyval($argn); } return $self->{digtype} unless defined $arg; return _digestbyval( $self->{digtype} ) if $arg =~ /MNEMONIC/i; return $self->{digtype} = _digestbyname($arg); } sub digest { my $self = shift; $self->digestbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->digestbin() if defined wantarray; } sub digestbin { my $self = shift; $self->{digestbin} = shift if scalar @_; $self->{digestbin} || ""; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->digestbin ) : ''; } sub create { my $class = shift; my $keyrr = shift; my %args = $keyrr->ttl ? ( ttl => $keyrr->ttl, @_ ) : (@_); my ($type) = reverse split '::', $class; my $kname = $keyrr->name; my $flags = $keyrr->flags; croak "Unable to create $kname $type record for non-DNSSEC key" unless $keyrr->protocol == 3; croak "Unable to create $kname $type record for non-authentication key" if $flags & 0x8000; croak "Unable to create $kname $type record for non-ZONE key" unless ( $flags & 0x300 ) == 0x100; my $self = new Net::DNS::RR( name => $kname, # per definition, same as keyrr type => $type, class => $keyrr->class, keytag => $keyrr->keytag, algorithm => $keyrr->algorithm, digtype => 1, # SHA1 by default %args ); my $owner = $self->{owner}->encode(); my $data = pack 'a* a*', $owner, $keyrr->_encode_rdata; my $arglist = $digest{$self->digtype}; my ( $object, @argument ) = @$arglist; my $hash = $object->new(@argument); $hash->add($data); $self->digestbin( $hash->digest ); return $self; } sub verify { my ( $self, $key ) = @_; my $verify = create Net::DNS::RR::DS( $key, ( digtype => $self->digtype ) ); return $verify->digestbin eq $self->digestbin; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name DS keytag algorithm digtype digest'); use Net::DNS::SEC; $ds = create Net::DNS::RR::DS( $dnskeyrr, digtype => 'SHA256', ttl => 3600 ); =head1 DESCRIPTION Class for DNS Delegation Signer (DS) resource record. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); The 16-bit numerical key tag of the key. (RFC2535 4.1.6) =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); Decimal representation of the 8-bit algorithm field. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 digtype $digtype = $rr->digtype; $rr->digtype( $digtype ); Decimal representation of the 8-bit digest type field. digtype() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 digest $digest = $rr->digest; $rr->digest( $digest ); Hexadecimal representation of the digest over the label and key. =head2 digestbin $digestbin = $rr->digestbin; $rr->digestbin( $digestbin ); Binary representation of the digest over the label and key. =head2 babble print $rr->babble; The babble() method returns the 'BubbleBabble' representation of the digest if the Digest::BubbleBabble package is available, otherwise an empty string is returned. BubbleBabble represents a message digest as a string of plausible words, to make the digest easier to verify. The "words" are not necessarily real words, but they look more like words than a string of hex characters. The 'BubbleBabble' string is appended as a comment when the string method is called. =head2 create use Net::DNS::SEC; $dsrr = create Net::DNS::RR::DS($keyrr, digtype => 'SHA-256' ); $keyrr->print; $dsrr->print; This constructor takes a key object as argument and will return the corresponding DS RR object. The digest type defaults to SHA-1. =head2 verify $verify = $dsrr->verify($keyrr); The boolean verify method will return true if the hash over the key RR provided as the argument conforms to the data in the DS itself i.e. the DS points to the DNSKEY from the argument. =head1 COPYRIGHT Copyright (c)2001-2005 RIPE NCC. Author Olaf M. Kolkman Portions Copyright (c)2013 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC4034, RFC3658 L, L =cut Net-DNS-1.07/lib/Net/DNS/RR/RRSIG.pm0000644000175000017500000005647513031240164015657 0ustar willemwillempackage Net::DNS::RR::RRSIG; # # $Id: RRSIG.pm 1505 2016-09-17 08:12:15Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1505 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::RRSIG - DNS RRSIG resource record =cut use integer; use Carp; use MIME::Base64; use Time::Local; use Net::DNS::Parameters; use constant DEBUG => 0; use constant UTIL => defined eval 'use Scalar::Util 1.24; 1;'; use constant PRIVATE => defined eval 'require Net::DNS::SEC::Private'; use constant DSA => defined eval 'require Net::DNS::SEC::DSA'; use constant RSA => defined eval 'require Net::DNS::SEC::RSA'; use constant ECDSA => defined eval 'require Net::DNS::SEC::ECDSA'; use constant GOST => defined eval 'require Net::DNS::SEC::ECCGOST'; use constant DNSSEC => PRIVATE && ( RSA || DSA || ECDSA || GOST ); my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{@field} = unpack "\@$offset n C2 N3 n", $$data; ( $self->{signame}, $offset ) = decode Net::DNS::DomainName( $data, $offset + 18 ); $self->{sigbin} = substr $$data, $offset, $limit - $offset; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $signame = $self->{signame} || return ''; pack 'n C2 N3 n a* a*', @{$self}{@field}, $signame->canonical, $self->sigbin; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $signame = $self->{signame} || return ''; my @sig64 = split /\s+/, encode_base64( $self->sigbin ); my @rdata = ( map( $self->$_, @field ), $signame->string, @sig64 ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach ( @field, qw(signame) ) { $self->$_(shift) } $self->signature(@_); } sub _defaults { ## specify RR attribute default values my $self = shift; $self->sigval(30); } # # source: http://www.iana.org/assignments/dns-sec-alg-numbers # { my @algbyname = ( ## Reserved => 0, # [RFC4034][RFC4398] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; my $map = sub { my $arg = shift; return $arg if $arg =~ /^\d/; $arg =~ s/[^A-Za-z0-9]//g; # strip non-alphanumerics uc($arg); }; my @pairedval = sort ( 1 .. 254, 1 .. 254 ); # also accept number my %algbyname = map &$map($_), @algbyname, @pairedval; sub _algbyname { my $name = shift; my $key = uc $name; # synthetic key $key =~ s/[^A-Z0-9]//g; # strip non-alphanumerics $algbyname{$key} || croak "unknown algorithm $name"; } sub _algbyval { my $value = shift; $algbyval{$value} || return $value; } } my $RSA = RSA ? 'Net::DNS::SEC::RSA' : 0; my $DSA = DSA ? 'Net::DNS::SEC::DSA' : 0; my $ECDSA = ECDSA ? 'Net::DNS::SEC::ECDSA' : 0; my $GOST = GOST ? 'Net::DNS::SEC::ECCGOST' : 0; my %SEC = ( 1 => $RSA, 3 => $DSA, 5 => $RSA, 6 => $DSA, 7 => $RSA, 8 => $RSA, 10 => $RSA, 12 => $GOST, 13 => $ECDSA, 14 => $ECDSA, ); sub typecovered { my $self = shift; $self->{typecovered} = typebyname(shift) if scalar @_; my $typecode = $self->{typecovered}; typebyval($typecode) if defined wantarray && defined $typecode; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _algbyname($arg); } sub labels { my $self = shift; $self->{labels} = 0 + shift if scalar @_; $self->{labels} || 0; } sub orgttl { my $self = shift; $self->{orgttl} = 0 + shift if scalar @_; $self->{orgttl} || 0; } sub sigexpiration { my $self = shift; $self->{sigexpiration} = _string2time(shift) if scalar @_; my $time = $self->{sigexpiration}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub siginception { my $self = shift; $self->{siginception} = _string2time(shift) if scalar @_; my $time = $self->{siginception}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub sigex { &sigexpiration; } ## historical sub sigin { &siginception; } ## historical sub sigval { my $self = shift; no integer; ( $self->{sigval} ) = map int( 86400 * $_ ), @_; } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; $self->{keytag} || 0; } sub signame { my $self = shift; $self->{signame} = new Net::DNS::DomainName(shift) if scalar @_; $self->{signame}->name if $self->{signame}; } sub sig { my $self = shift; $self->sigbin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->sigbin(), "" ) if defined wantarray; } sub sigbin { my $self = shift; $self->{sigbin} = shift if scalar @_; $self->{sigbin} || ""; } sub signature { &sig; } sub create { unless (DNSSEC) { croak 'Net::DNS::SEC support not available'; } else { my ( $class, $rrsetref, $priv_key, %etc ) = @_; $rrsetref = [$rrsetref] unless ref($rrsetref) eq 'ARRAY'; my $RR = $rrsetref->[0]; croak '$rrsetref is not reference to RR array' unless ref($RR) =~ /^Net::DNS::RR/; # All the TTLs need to be the same in the data RRset. my $ttl = $RR->ttl; my @ttl = grep $_->ttl != $ttl, @$rrsetref; croak 'RRs in RRset do not have same TTL' if scalar @ttl; my $private = ref($priv_key) ? $priv_key : Net::DNS::SEC::Private->new($priv_key); croak 'unable to parse private key' unless ref($private) eq 'Net::DNS::SEC::Private'; my @label = grep $_ ne chr(42), $RR->{owner}->_wire; # count labels my $self = new Net::DNS::RR( name => $RR->name, type => 'RRSIG', class => 'IN', ttl => $ttl, typecovered => $RR->type, labels => scalar @label, orgttl => $ttl, siginception => time(), algorithm => $private->algorithm, keytag => $private->keytag, signame => $private->signame, ); while ( my ( $attribute, $value ) = each %etc ) { $self->$attribute($value); } $self->{sigexpiration} = $self->{siginception} + $self->{sigval} unless $self->{sigexpiration}; $self->_CreateSig( $self->_CreateSigData($rrsetref), $private ); return $self; } } sub verify { # Reminder... # $rrsetref must be a reference to an array of RR objects. # $keyref is either a key object or a reference to an array # of key objects. if (DNSSEC) { my ( $self, $rrsetref, $keyref ) = @_; croak '$keyref argument is scalar or undefined' unless ref($keyref); print '$keyref argument is ', ref($keyref), "\n" if DEBUG; if ( ref($keyref) eq "ARRAY" ) { # We will recurse for each key that matches algorithm and key-id # and return when there is a successful verification. # If not, we will continue so that we can survive key-id collision. # The downside of this is that the error string only matches the # last error. print "Iterating over ", scalar(@$keyref), " keys\n" if DEBUG; my @error; my $i; foreach my $keyrr (@$keyref) { my $result = $self->verify( $rrsetref, $keyrr ); return $result if $result; my $error = $self->{vrfyerrstr}; $i++; push @error, "key $i: $error"; print "key $i: $error\n" if DEBUG; next; } $self->{vrfyerrstr} = join "\n", @error; return 0; } elsif ( $keyref->isa('Net::DNS::RR::DNSKEY') ) { print "Validating using key with keytag: ", $keyref->keytag, "\n" if DEBUG; } else { croak join ' ', ref($keyref), 'can not be used as DNSSEC key'; } $rrsetref = [$rrsetref] unless ref($rrsetref) eq 'ARRAY'; my $RR = $rrsetref->[0]; croak '$rrsetref not a reference to array of RRs' unless ref($RR) =~ /^Net::DNS::RR/; if (DEBUG) { print "\n ---------------------- RRSIG DEBUG --------------------"; print "\n SIG:\t", $self->string; print "\n KEY:\t", $keyref->string; print "\n -------------------------------------------------------\n"; } $self->{vrfyerrstr} = ''; unless ( $self->algorithm == $keyref->algorithm ) { $self->{vrfyerrstr} = 'algorithm does not match'; return 0; } unless ( $self->keytag == $keyref->keytag ) { $self->{vrfyerrstr} = 'keytag does not match'; return 0; } $self->_VerifySig( $self->_CreateSigData($rrsetref), $keyref ) || return 0; # time to do some time checking. my $t = time; if ( _ordered( $self->{sigexpiration}, $t ) ) { $self->{vrfyerrstr} = join ' ', 'Signature expired at', $self->sigexpiration; return 0; } elsif ( _ordered( $t, $self->{siginception} ) ) { $self->{vrfyerrstr} = join ' ', 'Signature valid from', $self->siginception; return 0; } return 1; } } #END verify sub vrfyerrstr { my $self = shift; $self->{vrfyerrstr}; } ######################################## sub _ordered($$) { ## irreflexive 32-bit partial ordering use integer; my ( $a, $b ) = @_; return defined $b unless defined $a; # ( undef, any ) return 0 unless defined $b; # ( any, undef ) # unwise to assume 32-bit arithmetic, or that integer overflow goes unpunished if ( $a < 0 ) { # translate $a<0 region $a = ( $a ^ 0x80000000 ) & 0xFFFFFFFF; # 0 <= $a < 2**31 $b = ( $b ^ 0x80000000 ) & 0xFFFFFFFF; # -2**31 <= $b < 2**32 } return $a < $b ? ( $a > ( $b - 0x80000000 ) ) : ( $b < ( $a - 0x80000000 ) ); } my $y1998 = timegm( 0, 0, 0, 1, 0, 1998 ); my $y2026 = timegm( 0, 0, 0, 1, 0, 2026 ); my $y2082 = $y2026 << 1; my $y2054 = $y2082 - $y1998; my $m2026 = int( 0x80000000 - $y2026 ); my $m2054 = int( 0x80000000 - $y2054 ); my $t2082 = int( $y2082 & 0x7FFFFFFF ); my $t2100 = 1960058752; sub _string2time { ## parse time specification string my $arg = shift; croak 'undefined time' unless defined $arg; return int($arg) if length($arg) < 12; my ( $y, $m, @dhms ) = unpack 'a4 a2 a2 a2 a2 a2', $arg . '00'; unless ( $arg gt '20380119031407' ) { # calendar folding return timegm( reverse(@dhms), $m - 1, $y ) if $y < 2026; return timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2026; } elsif ( $y > 2082 ) { my $z = timegm( reverse(@dhms), $m - 1, $y - 84 ); # expunge 29 Feb 2100 return $z < 1456790400 ? $z + $y2054 : $z + $y2054 - 86400; } return ( timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2054 ) - $y1998; } sub _time2string { ## format time specification string my $arg = shift; croak 'undefined time' unless defined $arg; my $ls31 = int( $arg & 0x7FFFFFFF ); if ( $arg & 0x80000000 ) { if ( $ls31 > $t2082 ) { $ls31 += 86400 unless $ls31 < $t2100; # expunge 29 Feb 2100 my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2054 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1984, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } elsif ( $ls31 > $y2026 ) { my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 - $y2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime $ls31 )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1900, $mm + 1, @dhms; } sub _CreateSigData { # This method creates the data string that will be signed. # See RFC4034(6) and RFC6840(5.1) on how this string is constructed # This method is called by the method that creates a signature # and by the method that verifies the signature. It is assumed # that the creation method has checked that all the TTLs are # the same for the rrsetref and that sig->orgttl has been set # to the TTL of the data. This method will set the datarr->ttl # to the sig->orgttl for all the RR in the rrsetref. if (DNSSEC) { my ( $self, $rrsetref ) = @_; print "_CreateSigData\n" if DEBUG; croak 'SIG0 using RRSIG not permitted' unless ref($rrsetref); my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); my $sigdata = pack 'n C2 N3 n a*', @{$self}{@field}, $self->{signame}->canonical; print "\npreamble\t", unpack( 'H*', $sigdata ), "\n" if DEBUG; my $owner = $self->{owner}; # create wildcard domain name my $limit = $self->{labels}; my @label = $owner->_wire; shift @label while scalar @label > $limit; my $wild = bless {label => \@label}, ref($owner); # DIY to avoid wrecking name cache my $suffix = $wild->canonical; unshift @label, chr(42); # asterisk my @RR = map bless( {%$_}, ref($_) ), @$rrsetref; # shallow RR clone my $RR = $RR[0]; my $class = $RR->class; my $type = $RR->type; my $ttl = $self->orgttl; my %table; foreach my $RR (@RR) { my $ident = $RR->{owner}->canonical; my $match = substr $ident, -length($suffix); croak 'RRs in RRset have different NAMEs' if $match ne $suffix; croak 'RRs in RRset have different TYPEs' if $type ne $RR->type; croak 'RRs in RRset have different CLASS' if $class ne $RR->class; $RR->ttl($ttl); # reset TTL my $offset = 10 + length($suffix); # RDATA offset if ( $ident ne $match ) { $RR->{owner} = $wild; $offset += 2; print "\nsubstituting wildcard name: ", $RR->name if DEBUG; } # For sorting we create a hash table of canonical data keyed on RDATA my $canonical = $RR->canonical; $table{substr $canonical, $offset} = $canonical; } $sigdata = join '', $sigdata, map $table{$_}, sort keys %table; if (DEBUG) { my $i = 0; foreach my $rdata ( sort keys %table ) { print "\n>>> ", $i++, "\tRDATA:\t", unpack 'H*', $rdata; print "\nRR: ", unpack( 'H*', $table{$rdata} ), "\n"; } print "\n sigdata:\t", unpack( 'H*', $sigdata ), "\n"; } return $sigdata; } } ######################################## sub _CreateSig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $SEC{$algorithm}; eval { die "algorithm $algorithm not supported" unless $class; $self->sigbin( $class->sign(@_) ); } || croak "${@}signature generation failed"; } } sub _VerifySig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $SEC{$algorithm}; my $retval = eval { die "algorithm $algorithm not supported" unless $class; $class->verify( @_, $self->sigbin ); }; unless ($retval) { $self->{vrfyerrstr} = "${@}signature verification failed"; print "\n", $self->{vrfyerrstr}, "\n" if DEBUG; return 0; } # uncoverable branch true # bug in Net::DNS::SEC or dependencies croak "unknown error in $class->verify" unless $retval == 1; print "\nalgorithm $algorithm verification successful\n" if DEBUG; return 1; } } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name RRSIG typecovered algorithm labels orgttl sigexpiration siginception keytag signame signature'); use Net::DNS::SEC; $sigrr = create Net::DNS::RR::RRSIG( \@rrset, $keypath, sigex => 20161231010101 sigin => 20161201010101 ); $sigrr->verify( \@rrset, $keyrr ) || die $sigrr->vrfyerrstr; =head1 DESCRIPTION Class for DNS digital signature (RRSIG) resource records. In addition to the regular methods inherited from Net::DNS::RR the class contains a method to sign RRsets using private keys (create) and a method for verifying signatures over RRsets (verify). The RRSIG RR is an implementation of RFC4034. See L for an implementation of SIG0 (RFC2931). =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 typecovered $typecovered = $rr->typecovered; The typecovered field identifies the type of the RRset that is covered by this RRSIG record. =head2 algorithm $algorithm = $rr->algorithm; The algorithm number field identifies the cryptographic algorithm used to create the signature. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 labels $labels = $rr->labels; $rr->labels( $labels ); The labels field specifies the number of labels in the original RRSIG RR owner name. =head2 orgttl $orgttl = $rr->orgttl; $rr->orgttl( $orgttl ); The original TTL field specifies the TTL of the covered RRset as it appears in the authoritative zone. =head2 sigexpiration and siginception times =head2 sigex sigin sigval $expiration = $rr->sigexpiration; $expiration = $rr->sigexpiration( $value ); $inception = $rr->siginception; $inception = $rr->siginception( $value ); The signature expiration and inception fields specify a validity time interval for the signature. The value may be specified by a string with format 'yyyymmddhhmmss' or a Perl time() value. Return values are dual-valued, providing either a string value or numerical Perl time() value. =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); The keytag field contains the key tag value of the DNSKEY RR that validates this signature. =head2 signame $signame = $rr->signame; $rr->signame( $signame ); The signer name field value identifies the owner name of the DNSKEY RR that a validator is supposed to use to validate this signature. =head2 signature =head2 sig $sig = $rr->sig; $rr->sig( $sig ); The Signature field contains the cryptographic signature that covers the RRSIG RDATA (excluding the Signature field) and the RRset specified by the RRSIG owner name, RRSIG class, and RRSIG type covered fields. =head2 sigbin $sigbin = $rr->sigbin; $rr->sigbin( $sigbin ); Binary representation of the cryptographic signature. =head2 create Create a signature over a RR set. use Net::DNS::SEC; $keypath = '/home/olaf/keys/Kbla.foo.+001+60114.private'; $sigrr = create Net::DNS::RR::RRSIG( \@rrsetref, $keypath ); $sigrr = create Net::DNS::RR::RRSIG( \@rrsetref, $keypath, sigex => 20161231010101 sigin => 20161201010101 ); $sigrr->print; # Alternatively use Net::DNS::SEC::Private $private = Net::DNS::SEC::Private->new($keypath); $sigrr= create Net::DNS::RR::RRSIG( \@rrsetref, $private ); create() is an alternative constructor for a RRSIG RR object. This method returns an RRSIG with the signature over the subject rrset (an array of RRs) made with the private key stored in the key file. The first argument is a reference to an array that contains the RRset that needs to be signed. The second argument is a string which specifies the path to a file containing the private key as generated by dnssec-keygen. The optional remaining arguments consist of ( name => value ) pairs as follows: sigex => 20161231010101, # signature expiration sigin => 20161201010101, # signature inception sigval => 30, # validity window (days) ttl => 3600 # TTL The sigin and sigex values may be specified as Perl time values or as a string with the format 'yyyymmddhhmmss'. The default for sigin is the time of signing. The sigval argument specifies the signature validity window in days ( sigex = sigin + sigval ). By default the signature is valid for 30 days. By default the TTL matches the RRset that is presented for signing. =head2 verify $verify = $sigrr->verify( $rrsetref, $keyrr ); $verify = $sigrr->verify( $rrsetref, [$keyrr, $keyrr2, $keyrr3] ); $rrsetref contains a reference to an array of RR objects and the method verifies the RRset against the signature contained in the $sigrr object itself using the public key in $keyrr. The second argument can either be a Net::DNS::RR::KEYRR object or a reference to an array of such objects. Verification will return successful as soon as one of the keys in the array leads to positive validation. Returns 0 on error and sets $sig->vrfyerrstr =head2 vrfyerrstr $verify = $sigrr->verify( $rrsetref, $keyrr ); print $sigrr->vrfyerrstr unless $verify; $sigrr->verify( $rrsetref, $keyrr ) || die $sigrr->vrfyerrstr; =head1 KEY GENERATION Private key files and corresponding public DNSKEY records are most conveniently generated using dnssec-keygen, a program that comes with the ISC BIND distribution. dnssec-keygen -a 10 -b 2048 -f ksk rsa.example. dnssec-keygen -a 10 -b 1024 rsa.example. dnssec-keygen -a 14 -f ksk ecdsa.example. dnssec-keygen -a 14 ecdsa.example. Do not change the name of the file generated by dnssec-keygen. The create method uses the filename to determine the keyowner, algorithm and the keyid (keytag). =head1 REMARKS The code is not optimised for speed. It is probably not suitable to be used for signing large zones. If this code is still around in 2100 (not a leap year) you will need to check for proper handling of times ... =head1 ACKNOWLEDGMENTS Andy Vaskys (Network Associates Laboratories) supplied the code for handling RSA with SHA1 (Algorithm 5). T.J. Mather, the Crypt::OpenSSL::DSA maintainer, for his quick responses to bug report and feature requests. Dick Franks added support for elliptic curve signatures. Mike McCauley created the Crypt::OpenSSL::ECDSA perl extension module specifically for this development. =head1 COPYRIGHT Copyright (c)2001-2005 RIPE NCC, Olaf M. Kolkman Copyright (c)2007-2008 NLnet Labs, Olaf M. Kolkman Portions Copyright (c)2014 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC4034, RFC6840, RFC3755, L, L, L, L L L =cut Net-DNS-1.07/lib/Net/DNS/RR/LP.pm0000644000175000017500000000776313031240164015300 0ustar willemwillempackage Net::DNS::RR::LP; # # $Id: LP.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::LP - DNS LP resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{target} = decode Net::DNS::DomainName( $data, $offset + 2 ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $target = $self->{target} || return ''; pack 'n a*', $self->preference, $target->encode(); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target} || return ''; join ' ', $self->preference, $target->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->target(shift); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub target { my $self = shift; $self->{target} = new Net::DNS::DomainName(shift) if scalar @_; $self->{target}->name if $self->{target}; } sub FQDN { shift->{target}->fqdn; } sub fqdn { shift->{target}->fqdn; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IN LP preference FQDN'); $rr = new Net::DNS::RR( name => 'example.com', type => 'LP', preference => 10, target => 'target.example.com.' ); =head1 DESCRIPTION Class for DNS Locator Pointer (LP) resource records. The LP DNS resource record (RR) is used to hold the name of a subnetwork for ILNP. The name is an FQDN which can then be used to look up L32 or L64 records. LP is, effectively, a Locator Pointer to L32 and/or L64 records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this LP record among other LP records associated with this owner name. Lower values are preferred over higher values. =head2 FQDN, fqdn =head2 target $target = $rr->target; $rr->target( $target ); The FQDN field contains the DNS target name that is used to reference L32 and/or L64 records. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6742 =cut Net-DNS-1.07/lib/Net/DNS/RR/IPSECKEY.pm0000644000175000017500000001571713031240164016177 0ustar willemwillempackage Net::DNS::RR::IPSECKEY; # # $Id: IPSECKEY.pm 1491 2016-06-22 07:47:21Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1491 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::IPSECKEY - DNS IPSECKEY resource record =cut use integer; use Carp; use MIME::Base64; use Net::DNS::DomainName; use Net::DNS::RR::A; use Net::DNS::RR::AAAA; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{qw(precedence gatetype algorithm)} = unpack "\@$offset C3", $$data; $offset += 3; my $gatetype = $self->{gatetype}; unless ($gatetype) { $self->{gateway} = undef; # no gateway } elsif ( $gatetype == 1 ) { $self->{gateway} = unpack "\@$offset a4", $$data; $offset += 4; } elsif ( $gatetype == 2 ) { $self->{gateway} = unpack "\@$offset a16", $$data; $offset += 16; } elsif ( $gatetype == 3 ) { my $name; ( $name, $offset ) = decode Net::DNS::DomainName( $data, $offset ); $self->{gateway} = $name; } else { die "unknown gateway type ($gatetype)"; } $self->keybin( substr $$data, $offset, $limit - $offset ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{algorithm}; my $gatetype = $self->gatetype; my $gateway = $self->{gateway}; my $precedence = $self->precedence; my $algorithm = $self->algorithm; my $keybin = $self->keybin; unless ($gatetype) { return pack 'C3 a*', $precedence, $gatetype, $algorithm, $keybin; } elsif ( $gatetype == 1 ) { return pack 'C3 a4 a*', $precedence, $gatetype, $algorithm, $gateway, $keybin; } elsif ( $gatetype == 2 ) { return pack 'C3 a16 a*', $precedence, $gatetype, $algorithm, $gateway, $keybin; } elsif ( $gatetype == 3 ) { my $namebin = $gateway->encode; return pack 'C3 a* a*', $precedence, $gatetype, $algorithm, $namebin, $keybin; } die "unknown gateway type ($gatetype)"; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{algorithm}; my @params = map $self->$_, qw(precedence gatetype algorithm); my @base64 = split /\s+/, encode_base64( $self->keybin ); my @rdata = ( @params, $self->gateway, @base64 ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(precedence gatetype algorithm gateway)) { $self->$_(shift) } $self->key(@_); } sub precedence { my $self = shift; $self->{precedence} = 0 + shift if scalar @_; $self->{precedence} || 0; } sub gatetype { return shift->{gatetype} || 0; } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; $self->{algorithm} || 0; } sub gateway { my $self = shift; for (@_) { /^\.*$/ && do { $self->{gatetype} = 0; $self->{gateway} = undef; # no gateway last; }; /:.*:/ && do { $self->{gatetype} = 2; $self->{gateway} = Net::DNS::RR::AAAA::address( {}, $_ ); last; }; /\.\d+$/ && do { $self->{gatetype} = 1; $self->{gateway} = Net::DNS::RR::A::address( {}, $_ ); last; }; /\..+/ && do { $self->{gatetype} = 3; $self->{gateway} = new Net::DNS::DomainName($_); last; }; croak "unrecognised gateway type"; } if ( defined wantarray ) { my $gatetype = $self->{gatetype}; return wantarray ? '.' : undef unless $gatetype; my $gateway = $self->{gateway}; for ($gatetype) { /^1$/ && return Net::DNS::RR::A::address( {address => $gateway} ); /^2$/ && return Net::DNS::RR::AAAA::address( {address => $gateway} ); /^3$/ && return wantarray ? $gateway->string : $gateway->name; die "unknown gateway type ($gatetype)"; } } } sub key { my $self = shift; $self->keybin( MIME::Base64::decode( join "", @_ ) ) if scalar @_; MIME::Base64::encode( $self->keybin(), "" ) if defined wantarray; } sub keybin { my $self = shift; $self->{keybin} = shift if scalar @_; $self->{keybin} || ""; } sub pubkey { &key; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name IPSECKEY precedence gatetype algorithm gateway key'); =head1 DESCRIPTION DNS IPSEC Key Storage (IPSECKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 precedence $precedence = $rr->precedence; $rr->precedence( $precedence ); This is an 8-bit precedence for this record. Gateways listed in IPSECKEY records with lower precedence are to be attempted first. =head2 gatetype $gatetype = $rr->gatetype; The gateway type field indicates the format of the information that is stored in the gateway field. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The algorithm type field identifies the public keys cryptographic algorithm and determines the format of the public key field. =head2 gateway $gateway = $rr->gateway; $rr->gateway( $gateway ); The gateway field indicates a gateway to which an IPsec tunnel may be created in order to reach the entity named by this resource record. =head2 pubkey =head2 key $key = $rr->key; $rr->key( $key ); Base64 representation of the optional public key block for the resource record. =head2 keybin $keybin = $rr->keybin; $rr->keybin( $keybin ); Binary representation of the public key block for the resource record. =head1 COPYRIGHT Copyright (c)2007 Olaf Kolkman, NLnet Labs. Portions Copyright (c)2012,2015 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC4025 =cut Net-DNS-1.07/lib/Net/DNS/RR/PX.pm0000644000175000017500000001036313031240164015302 0ustar willemwillempackage Net::DNS::RR::PX; # # $Id: PX.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::PX - DNS PX resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); ( $self->{map822}, $offset ) = decode Net::DNS::DomainName2535( $data, $offset + 2, @opaque ); ( $self->{mapx400}, $offset ) = decode Net::DNS::DomainName2535( $data, $offset + 0, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $mapx400 = $self->{mapx400} || return ''; my $rdata = pack( 'n', $self->{preference} ); $rdata .= $self->{map822}->encode( $offset + 2, @opaque ); $rdata .= $mapx400->encode( $offset + length($rdata), @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $mapx400 = $self->{mapx400} || return ''; join ' ', $self->preference, $self->{map822}->string, $mapx400->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->map822(shift); $self->mapx400(shift); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub map822 { my $self = shift; $self->{map822} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{map822}->name if $self->{map822}; } sub mapx400 { my $self = shift; $self->{mapx400} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{mapx400}->name if $self->{mapx400}; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name PX preference map822 mapx400'); =head1 DESCRIPTION Class for DNS X.400 Mail Mapping Information (PX) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer which specifies the preference given to this RR among others at the same owner. Lower values are preferred. =head2 map822 $map822 = $rr->map822; $rr->map822( $map822 ); A domain name element containing , the RFC822 part of the MIXER Conformant Global Address Mapping. =head2 mapx400 $mapx400 = $rr->mapx400; $rr->mapx400( $mapx400 ); A element containing the value of derived from the X.400 part of the MIXER Conformant Global Address Mapping. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC2163 =cut Net-DNS-1.07/lib/Net/DNS/RR/RT.pm0000644000175000017500000000745413031240164015307 0ustar willemwillempackage Net::DNS::RR::RT; # # $Id: RT.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::RT - DNS RT resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{intermediate} = decode Net::DNS::DomainName2535( $data, $offset + 2, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $intermediate = $self->{intermediate} || return ''; pack 'n a*', $self->preference, $intermediate->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $intermediate = $self->{intermediate} || return ''; join ' ', $self->preference, $intermediate->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->intermediate(shift); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub intermediate { my $self = shift; $self->{intermediate} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{intermediate}->name if $self->{intermediate}; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name RT preference intermediate'); =head1 DESCRIPTION Class for DNS Route Through (RT) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer representing the preference of the route. Smaller numbers indicate more preferred routes. =head2 intermediate $intermediate = $rr->intermediate; $rr->intermediate( $intermediate ); The domain name of a host which will serve as an intermediate in reaching the host specified by the owner name. The DNS RRs associated with the intermediate host are expected to include at least one A, X25, or ISDN record. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1183 Section 3.3 =cut Net-DNS-1.07/lib/Net/DNS/RR/DNAME.pm0000644000175000017500000000551313031240164015600 0ustar willemwillempackage Net::DNS::RR::DNAME; # # $Id: DNAME.pm 1456 2016-02-17 13:34:00Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1456 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DNAME - DNS DNAME resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{target} = decode Net::DNS::DomainName2535(@_); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $target = $self->{target} || return ''; $target->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target} || return ''; $target->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->target(shift); } sub target { my $self = shift; $self->{target} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{target}->name if $self->{target}; } sub dname { ⌖ } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name DNAME target'); =head1 DESCRIPTION Class for DNS Non-Terminal Name Redirection (DNAME) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 target $target = $rr->target; $rr->target( $target ); Redirection target domain name which is to be substituted for its owner as a suffix of a domain name. =head1 COPYRIGHT Copyright (c)2002 Andreas Gustafsson. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6672 =cut Net-DNS-1.07/lib/Net/DNS/RR/KX.pm0000644000175000017500000000714413031240164015300 0ustar willemwillempackage Net::DNS::RR::KX; # # $Id: KX.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::KX - DNS KX resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{exchange} = decode Net::DNS::DomainName2535( $data, $offset + 2, @opaque ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $exchange = $self->{exchange} || return ''; pack 'n a*', $self->preference, $exchange->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $exchange = $self->{exchange} || return ''; join ' ', $self->preference, $exchange->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->exchange(shift); } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; $self->{preference} || 0; } sub exchange { my $self = shift; $self->{exchange} = new Net::DNS::DomainName2535(shift) if scalar @_; $self->{exchange}->name if $self->{exchange}; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name KX preference exchange'); =head1 DESCRIPTION DNS Key Exchange Delegation (KX) record =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer which specifies the preference given to this RR among others at the same owner. Lower values are preferred. =head2 exchange $exchange = $rr->exchange; $rr->exchange( $exchange ); A domain name which specifies a host willing to act as a key exchange for the owner name. =head1 COPYRIGHT Copyright (c)2009 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC2230 =cut Net-DNS-1.07/lib/Net/DNS/RR/TLSA.pm0000644000175000017500000001241513031240164015516 0ustar willemwillempackage Net::DNS::RR::TLSA; # # $Id: TLSA.pm 1488 2016-06-07 09:04:50Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1488 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::TLSA - DNS TLSA resource record =cut use integer; use constant BABBLE => defined eval 'require Digest::BubbleBabble'; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $next = $offset + $self->{rdlength}; @{$self}{qw(usage selector matchingtype)} = unpack "\@$offset C3", $$data; $offset += 3; $self->{certbin} = substr $$data, $offset, $next - $offset; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{certbin}; return pack 'C3 a*', @{$self}{qw(usage selector matchingtype certbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{certbin}; $self->_annotation( $self->babble ) if BABBLE; my @cert = split /(\S{64})/, $self->cert; my @rdata = ( $self->usage, $self->selector, $self->matchingtype, @cert ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->usage(shift); $self->selector(shift); $self->matchingtype(shift); $self->cert(@_); } sub usage { my $self = shift; $self->{usage} = 0 + shift if scalar @_; $self->{usage} || 0; } sub selector { my $self = shift; $self->{selector} = 0 + shift if scalar @_; $self->{selector} || 0; } sub matchingtype { my $self = shift; $self->{matchingtype} = 0 + shift if scalar @_; $self->{matchingtype} || 0; } sub cert { my $self = shift; $self->certbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->certbin() if defined wantarray; } sub certbin { my $self = shift; $self->{certbin} = shift if scalar @_; $self->{certbin} || ""; } sub certificate { &cert; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->certbin ) : ''; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name TLSA usage selector matchingtype certificate'); =head1 DESCRIPTION The Transport Layer Security Authentication (TLSA) DNS resource record is used to associate a TLS server certificate or public key with the domain name where the record is found, forming a "TLSA certificate association". The semantics of how the TLSA RR is interpreted are described in RFC6698. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 usage $usage = $rr->usage; $rr->usage( $usage ); 8-bit integer value which specifies the provided association that will be used to match the certificate presented in the TLS handshake. =head2 selector $selector = $rr->selector; $rr->selector( $selector ); 8-bit integer value which specifies which part of the TLS certificate presented by the server will be matched against the association data. =head2 matchingtype $matchingtype = $rr->matchingtype; $rr->matchingtype( $matchingtype ); 8-bit integer value which specifies how the certificate association is presented. =head2 certificate =head2 cert $cert = $rr->cert; $rr->cert( $cert ); Hexadecimal representation of the certificate data. =head2 certbin $certbin = $rr->certbin; $rr->certbin( $certbin ); Binary representation of the certificate data. =head2 babble print $rr->babble; The babble() method returns the 'BubbleBabble' representation of the digest if the Digest::BubbleBabble package is available, otherwise an empty string is returned. BubbleBabble represents a message digest as a string of plausible words, to make the digest easier to verify. The "words" are not necessarily real words, but they look more like words than a string of hex characters. The 'BubbleBabble' string is appended as a comment when the string method is called. =head1 COPYRIGHT Copyright (c)2012 Willem Toorop, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC6698 =cut Net-DNS-1.07/lib/Net/DNS/RR/DHCID.pm0000644000175000017500000001211013031240164015556 0ustar willemwillempackage Net::DNS::RR::DHCID; # # $Id: DHCID.pm 1390 2015-09-11 11:42:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1390 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DHCID - DNS DHCID resource record =cut use integer; use MIME::Base64; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $size = $self->{rdlength} - 3; @{$self}{qw(identifiertype digesttype digest)} = unpack "\@$offset nC a$size", $$data; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{digest}; pack 'nC a*', map $self->$_, qw(identifiertype digesttype digest); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @base64 = split /\s+/, encode_base64( $self->_encode_rdata ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; my $data = MIME::Base64::decode( join "", @_ ); my $size = length($data) - 3; @{$self}{qw(identifiertype digesttype digest)} = unpack "n C a$size", $data; } # +------------------+------------------------------------------------+ # | Identifier Type | Identifier | # | Code | | # +------------------+------------------------------------------------+ # | 0x0000 | The 1-octet 'htype' followed by 'hlen' octets | # | | of 'chaddr' from a DHCPv4 client's DHCPREQUEST | # | | [7]. | # | 0x0001 | The data octets (i.e., the Type and | # | | Client-Identifier fields) from a DHCPv4 | # | | client's Client Identifier option [10]. | # | 0x0002 | The client's DUID (i.e., the data octets of a | # | | DHCPv6 client's Client Identifier option [11] | # | | or the DUID field from a DHCPv4 client's | # | | Client Identifier option [6]). | # | 0x0003 - 0xfffe | Undefined; available to be assigned by IANA. | # | 0xffff | Undefined; RESERVED. | # +------------------+------------------------------------------------+ sub identifiertype { my $self = shift; $self->{identifiertype} = 0 + shift if scalar @_; $self->{identifiertype} || 0; } sub digesttype { my $self = shift; $self->{digesttype} = 0 + shift if scalar @_; $self->{digesttype} || 0; } sub digest { my $self = shift; $self->{digest} = shift if scalar @_; $self->{digest} || ""; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('client.example.com. DHCID ( AAAB xLmlskllE0MVjd57zHcWmEH3pCQ6VytcKD//7es/deY='); $rr = new Net::DNS::RR( name => 'client.example.com', type => 'DHCID', digest => 'ObfuscatedIdentityData', digesttype => 1, identifiertype => 2, ); =head1 DESCRIPTION DNS RR for Encoding DHCP Information (DHCID) =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 identifiertype $identifiertype = $rr->identifiertype; $rr->identifiertype( $identifiertype ); The 16-bit identifier type describes the form of host identifier used to construct the DHCP identity information. =head2 digesttype $digesttype = $rr->digesttype; $rr->digesttype( $digesttype ); The 8-bit digest type number describes the message-digest algorithm used to obfuscate the DHCP identity information. =head2 digest $digest = $rr->digest; $rr->digest( $digest ); Binary representation of the digest of DHCP identity information. =head1 COPYRIGHT Copyright (c)2009 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC4701 =cut Net-DNS-1.07/lib/Net/DNS/RR/NSEC3.pm0000644000175000017500000002444713031240164015576 0ustar willemwillempackage Net::DNS::RR::NSEC3; # # $Id: NSEC3.pm 1456 2016-02-17 13:34:00Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1456 $)[1]; use strict; use base qw(Net::DNS::RR::NSEC); =head1 NAME Net::DNS::RR::NSEC3 - DNS NSEC3 resource record =cut use integer; use Carp; use base qw(Exporter); use vars qw(@EXPORT_OK); @EXPORT_OK = qw(name2hash); require Net::DNS::DomainName; eval 'require Digest::SHA'; ## optional for simple Net::DNS RR my %digest = ( '1' => ['Digest::SHA', 1], # RFC3658 ); { my @digestbyname = ( 'SHA-1' => 1, # RFC3658 ); my @digestbyalias = ( 'SHA' => 1 ); my %digestbyval = reverse @digestbyname; my @digestbynum = map { ( $_, 0 + $_ ) } keys %digestbyval; # accept algorithm number my %digestbyname = map { s /[^A-Za-z0-9]//g; $_ } @digestbyalias, @digestbyname, @digestbynum; sub _digestbyname { my $name = shift; my $key = uc $name; # synthetic key $key =~ s /[^A-Z0-9]//g; # strip non-alphanumerics $digestbyname{$key} || croak "unknown digest type $name"; } sub _digestbyval { my $value = shift; $digestbyval{$value} || return $value; } } sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; my $ssize = unpack "\@$offset x4 C", $$data; @{$self}{qw(algorithm flags iterations saltbin)} = unpack "\@$offset CCnx a$ssize", $$data; $offset += 5 + $ssize; my $hsize = unpack "\@$offset C", $$data; $self->{hnxtname} = unpack "\@$offset x a$hsize", $$data; $offset += 1 + $hsize; $self->{typebm} = substr $$data, $offset, ( $limit - $offset ); } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{typebm}; my $salt = $self->saltbin; my $hash = $self->{hnxtname}; pack 'CCn C a* C a* a*', $self->algorithm, $self->flags, $self->iterations, length($salt), $salt, length($hash), $hash, $self->{typebm}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{typebm}; my @rdata = ( $self->algorithm, $self->flags, $self->iterations, $self->salt || '-', $self->hnxtname, $self->typelist ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->algorithm(shift); $self->flags(shift); $self->iterations(shift); my $salt = shift; $self->salt($salt) unless $salt eq '-'; $self->hnxtname(shift); $self->typelist(@_); } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata( 1, 0, 0, '' ); } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _digestbyname($argn) : _digestbyval($argn); } return $self->{algorithm} unless defined $arg; return _digestbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _digestbyname($arg); } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; $self->{flags} || 0; } sub optout { my $bit = 0x01; for ( shift->{flags} ) { my $set = $bit | ( $_ ||= 0 ); return $bit & $_ unless scalar @_; $_ = (shift) ? $set : ( $set ^ $bit ); return $_ & $bit; } } sub iterations { my $self = shift; $self->{iterations} = 0 + shift if scalar @_; $self->{iterations} || 0; } sub salt { my $self = shift; $self->saltbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->saltbin() if defined wantarray; } sub saltbin { my $self = shift; $self->{saltbin} = shift if scalar @_; $self->{saltbin} || ""; } sub hnxtname { my $self = shift; $self->{hnxtname} = _decode_base32(shift) if scalar @_; _encode_base32( $self->{hnxtname} ) if defined wantarray; } sub covered { my $self = shift; my $name = shift; # first test if the domain name is in the NSEC3 zone. my @domainlabels = new Net::DNS::DomainName($name)->_wire; my ( $owner, @zonelabels ) = $self->{owner}->_wire; my $ownerhash = _decode_base32($owner); foreach ( reverse @zonelabels ) { return 0 unless lc($_) eq lc( pop(@domainlabels) || return 0 ); } my $namehash = _hash( $self->algorithm, $name, $self->iterations, $self->saltbin ); my $nexthash = "$self->{hnxtname}"; unless ( $ownerhash lt $nexthash ) { # last or only NSEC3 RR return 1 if $namehash lt $nexthash; return $namehash gt $ownerhash; } return 0 unless $namehash gt $ownerhash; # general case return $namehash lt $nexthash; } sub match { my $self = shift; my $name = shift; my $namehash = _hash( $self->algorithm, $name, $self->iterations, $self->saltbin ); my ($owner) = $self->{owner}->_wire; my $ownerhash = _decode_base32($owner); $namehash eq $ownerhash; } ######################################## sub _decode_base32 { local $_ = shift || ''; tr [0-9a-vA-V] [\000-\037\012-\037]; $_ = unpack 'B*', $_; s/000(.....)/$1/g; my $l = length; $_ = substr $_, 0, $l & ~7 if $l & 7; pack 'B*', $_; } sub _encode_base32 { local $_ = unpack 'B*', shift; s/(.....)/000$1/g; my $l = length; my $x = substr $_, $l & ~7; my $n = length $x; substr( $_, $l & ~7 ) = join '', '000', $x, '0' x ( 5 - $n ) if $n; $_ = pack( 'B*', $_ ); tr [\000-\037] [0-9a-v]; return $_; } sub _hash { my $hashalg = shift; my $name = shift; my $iterations = shift; my $salt = shift || ''; my $arglist = $digest{$hashalg}; my ( $object, @argument ) = @$arglist; my $hash = $object->new(@argument); my $wirename = new Net::DNS::DomainName($name)->canonical; $iterations++; while ( $iterations-- ) { $hash->add($wirename); $hash->add($salt); $wirename = $hash->digest; } return $wirename; } sub name2hash { _encode_base32(&_hash); } # uncoverable pod sub hashalgo { &algorithm; } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name NSEC3 algorithm flags iterations salt hnxtname'); =head1 DESCRIPTION Class for DNSSEC NSEC3 resource records. The NSEC3 Resource Record (RR) provides authenticated denial of existence for DNS Resource Record Sets. The NSEC3 RR lists RR types present at the original owner name of the NSEC3 RR. It includes the next hashed owner name in the hash order of the zone. The complete set of NSEC3 RRs in a zone indicates which RRSets exist for the original owner name of the RR and form a chain of hashed owner names in the zone. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The Hash Algorithm field is represented as an unsigned decimal integer. The value has a maximum of 255. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); The Flags field is represented as an unsigned decimal integer. The value has a maximum value of 255. =over 4 =item optout $rr->optout(1); if ( $rr->optout ) { ... } Boolean Opt Out flag. =back =head2 iterations $iterations = $rr->iterations; $rr->iterations( $iterations ); The Iterations field is represented as an unsigned decimal integer. The value is between 0 and 65535, inclusive. =head2 salt $salt = $rr->salt; $rr->salt( $salt ); The Salt field is represented as a contiguous sequence of hexadecimal digits. A "-" (unquoted) is used in string format to indicate that the salt field is absent. =head2 saltbin $saltbin = $rr->saltbin; $rr->saltbin( $saltbin ); The Salt field as a sequence of octets. =head2 hnxtname $hnxtname = $rr->hnxtname; $rr->hnxtname( $hnxtname ); The Next Hashed Owner Name field points to the next node that has authoritative data or contains a delegation point NS RRset. =head2 typelist @typelist = $rr->typelist; $typelist = $rr->typelist; $rr->typelist( @typelist ); The Type List identifies the RRset types that exist at the domain name matched by the NSEC3 RR. When called in scalar context, the list is interpolated into a string. =head2 covered, match print "covered" if $rr->covered{'example.foo'} covered() returns a nonzero value when the the domain name provided as argument is covered as defined in the NSEC3 specification: To cover: An NSEC3 RR is said to "cover" a name if the hash of the name or "next closer" name falls between the owner name and the next hashed owner name of the NSEC3. In other words, if it proves the nonexistence of the name, either directly or by proving the nonexistence of an ancestor of the name. Similarly matched() returns a nonzero value when the domainname in the argument matches as defined in the NSEC3 specification: To match: An NSEC3 RR is said to "match" a name if the owner name of the NSEC3 RR is the same as the hashed owner name of that name. =head1 COPYRIGHT Copyright (c)2007,2008 NLnet Labs. Author Olaf M. Kolkman All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC5155, RFC4648 L =cut Net-DNS-1.07/lib/Net/DNS/RR/SMIMEA.pm0000644000175000017500000001232713031240164015730 0ustar willemwillempackage Net::DNS::RR::SMIMEA; # # $Id: SMIMEA.pm 1488 2016-06-07 09:04:50Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1488 $)[1]; use strict; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SMIMEA - DNS SMIMEA resource record =cut use integer; use constant BABBLE => defined eval 'require Digest::BubbleBabble'; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $next = $offset + $self->{rdlength}; @{$self}{qw(usage selector matchingtype)} = unpack "\@$offset C3", $$data; $offset += 3; $self->{certbin} = substr $$data, $offset, $next - $offset; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{certbin}; return pack 'C3 a*', @{$self}{qw(usage selector matchingtype certbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{certbin}; $self->_annotation( $self->babble ) if BABBLE; my @cert = split /(\S{64})/, $self->cert; my @rdata = ( $self->usage, $self->selector, $self->matchingtype, @cert ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->usage(shift); $self->selector(shift); $self->matchingtype(shift); $self->cert(@_); } sub usage { my $self = shift; $self->{usage} = 0 + shift if scalar @_; $self->{usage} || 0; } sub selector { my $self = shift; $self->{selector} = 0 + shift if scalar @_; $self->{selector} || 0; } sub matchingtype { my $self = shift; $self->{matchingtype} = 0 + shift if scalar @_; $self->{matchingtype} || 0; } sub cert { my $self = shift; $self->certbin( pack "H*", map { die "!hex!" if m/[^0-9A-Fa-f]/; $_ } join "", @_ ) if scalar @_; unpack "H*", $self->certbin() if defined wantarray; } sub certbin { my $self = shift; $self->{certbin} = shift if scalar @_; $self->{certbin} || ""; } sub certificate { &cert; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->certbin ) : ''; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('name SMIMEA usage selector matchingtype certificate'); =head1 DESCRIPTION The SMIMEA DNS resource record (RR) is used to associate an end entity certificate or public key with the associated email address, thus forming a "SMIMEA certificate association". The semantics of how the SMIMEA RR is interpreted are described in RFC6698. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 usage $usage = $rr->usage; $rr->usage( $usage ); 8-bit integer value which specifies the provided association that will be used to match the certificate. =head2 selector $selector = $rr->selector; $rr->selector( $selector ); 8-bit integer value which specifies which part of the certificate presented by the server will be matched against the association data. =head2 matchingtype $matchingtype = $rr->matchingtype; $rr->matchingtype( $matchingtype ); 8-bit integer value which specifies how the certificate association is presented. =head2 certificate =head2 cert $cert = $rr->cert; $rr->cert( $cert ); Hexadecimal representation of the certificate data. =head2 certbin $certbin = $rr->certbin; $rr->certbin( $certbin ); Binary representation of the certificate data. =head2 babble print $rr->babble; The babble() method returns the 'BubbleBabble' representation of the digest if the Digest::BubbleBabble package is available, otherwise an empty string is returned. BubbleBabble represents a message digest as a string of plausible words, to make the digest easier to verify. The "words" are not necessarily real words, but they look more like words than a string of hex characters. The 'BubbleBabble' string is appended as a comment when the string method is called. =head1 COPYRIGHT Copyright (c)2016 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, draft-ietf-dane-smimea, RFC6698 =cut Net-DNS-1.07/lib/Net/DNS/Resolver.pm0000644000175000017500000005263713031240164016243 0ustar willemwillempackage Net::DNS::Resolver; # # $Id: Resolver.pm 1508 2016-09-29 12:58:11Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1508 $)[1]; =head1 NAME Net::DNS::Resolver - DNS resolver class =cut use strict; use constant CONFIG => defined eval "require Net::DNS::Resolver::$^O"; use constant OS_CONF => join '::', __PACKAGE__, CONFIG ? $^O : 'UNIX'; use base OS_CONF; 1; __END__ =head1 SYNOPSIS use Net::DNS; $resolver = new Net::DNS::Resolver(); # Perform a lookup, using the searchlist if appropriate. $reply = $resolver->search( 'example.com' ); # Perform a lookup, without the searchlist $reply = $resolver->query( 'example.com', 'MX' ); # Perform a lookup, without pre or post-processing $reply = $resolver->send( 'example.com', 'MX', 'IN' ); # Send a prebuilt query packet $query = new Net::DNS::Packet( ... ); $reply = $resolver->send( $packet ); =head1 DESCRIPTION Instances of the C class represent resolver objects. A program can have multiple resolver objects, each maintaining its own state information such as the nameservers to be queried, whether recursion is desired, etc. =head1 METHODS =head2 new # Use the default configuration $resolver = new Net::DNS::Resolver(); # Use my own configuration file $resolver = new Net::DNS::Resolver( config_file => '/my/dns.conf' ); # Set options in the constructor $resolver = new Net::DNS::Resolver( nameservers => [ '10.1.1.128', '10.1.2.128' ], recurse => 0, debug => 1 ); Returns a resolver object. If no arguments are supplied, new() returns an object having the default configuration. On Unix and Linux systems, the default values are read from the following files, in the order indicated: /etc/resolv.conf $HOME/.resolv.conf ./.resolv.conf The following keywords are recognised in resolver configuration files: =over 4 =item domain The default domain. =item search A space-separated list of domains to put in the search list. =item nameserver A space-separated list of nameservers to query. =item options A space-separated list of key:value items. =back Except for F, files will only be read if owned by the effective userid running the program. In addition, several environment variables may contain configuration information; see L. Note that the domain and searchlist keywords are mutually exclusive. If both are present, the resulting behaviour is unspecified. On Windows systems, an attempt is made to determine the system defaults using the registry. Systems with many dynamically configured network interfaces may confuse Net::DNS. You can include a configuration file of your own when creating a resolver object: # Use my own configuration file $resolver = new Net::DNS::Resolver( config_file => '/my/dns.conf' ); This is supported on both Unix and Windows. If a custom configuration file is specified at first instantiation, both the system configuration and environment variables are ignored. Explicit arguments to new() override the corresponding configuration variables. The following arguments are supported: =over 4 =item nameservers A reference to an array of nameservers to query. =item domain Domain name suffix to be appended to queries of unqualified names. =item searchlist A reference to an array of domains to search for unqualified names. =item debug =item defnames =item dnsrch =item dnssec =item igntc =item persistent_tcp =item persistent_udp =item port =item recurse =item retrans =item retry =item srcaddr =item srcport =item tcp_timeout =item udp_timeout =item usevc =back For more information on any of these options, please consult the method of the same name. =head2 print $resolver->print; Prints the resolver state on the standard output. =head2 query $packet = $resolver->query( 'mailhost' ); $packet = $resolver->query( 'mailhost.example.com' ); $packet = $resolver->query( '192.0.2.1' ); $packet = $resolver->query( 'example.com', 'MX' ); $packet = $resolver->query( 'annotation.example.com', 'TXT', 'IN' ); Performs a DNS query for the given name; the search list is not applied. If the name does not contain any dots and C is true, the default domain will be appended. The record type and class can be omitted; they default to A and IN. If the name looks like an IP address (IPv4 or IPv6), then a query within in-addr.arpa or ip6.arpa will be performed. Returns a C object, or C if no answers were found. The reason for failure may be determined using errorstring(). If you need to examine the response packet, whether it contains any answers or not, use the send() method instead. =head2 search $packet = $resolver->search( 'mailhost' ); $packet = $resolver->search( 'mailhost.example.com' ); $packet = $resolver->search( '192.0.2.1' ); $packet = $resolver->search( 'example.com', 'MX' ); $packet = $resolver->search( 'annotation.example.com', 'TXT', 'IN' ); Performs a DNS query for the given name, applying the searchlist if appropriate. The search algorithm is as follows: =over 4 =item 1. If the name contains at least one dot, try it as is. =item 2. If the name does not end in a dot, try appending each item in the search list to the name. This is only done if C is true. =item 3. If the name does not contain any dots, try it as is. =back The record type and class can be omitted; they default to A and IN. If the name looks like an IP address (IPv4 or IPv6), then a query within in-addr.arpa or ip6.arpa will be performed. Returns a C object, or C if no answers were found. The reason for failure may be determined using errorstring(). If you need to examine the response packet, whether it contains any answers or not, use the send() method instead. =head2 send $packet = $resolver->send( $packet ); $packet = $resolver->send( 'mailhost.example.com' ); $packet = $resolver->query( '192.0.2.1' ); $packet = $resolver->send( 'example.com', 'MX' ); $packet = $resolver->send( 'annotation.example.com', 'TXT', 'IN' ); Performs a DNS query for the given name. Neither the searchlist nor the default domain will be appended. The argument list can be either a C object or a list of strings. The record type and class can be omitted; they default to A and IN. If the name looks like an IP address (IPv4 or IPv6), then a query within in-addr.arpa or ip6.arpa will be performed. Returns a C object whether there were any answers or not. Use C<< $packet->header->ancount >> or C<< $packet->answer >> to find out if there were any records in the answer section. Returns C if no response was received. =head2 axfr @zone = $resolver->axfr(); @zone = $resolver->axfr( 'example.com' ); @zone = $resolver->axfr( 'example.com', 'IN' ); $iterator = $resolver->axfr(); $iterator = $resolver->axfr( 'example.com' ); $iterator = $resolver->axfr( 'example.com', 'IN' ); $rr = $iterator->(); Performs a zone transfer using the resolver nameservers list, attempted in the order listed. If the zone is omitted, it defaults to the first zone listed in the resolver search list. If the class is omitted, it defaults to IN. When called in list context, axfr() returns a list of C objects. The redundant SOA record that terminates the zone transfer is not returned to the caller. In deferrence to RFC1035(6.3), a complete zone transfer is expected to return all records in the zone or nothing at all. When no resource records are returned by axfr(), the reason for failure may be determined using errorstring(). Here is an example that uses a timeout and TSIG verification: $resolver->tcp_timeout( 10 ); $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' ); @zone = $resolver->axfr( 'example.com' ); foreach $rr (@zone) { $rr->print; } When called in scalar context, axfr() returns an iterator object. Each invocation of the iterator returns a single C or C when the zone is exhausted. An exception is raised if the zone transfer can not be completed. The redundant SOA record that terminates the zone transfer is not returned to the caller. Here is the example above, implemented using an iterator: $resolver->tcp_timeout( 10 ); $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' ); $iterator = $resolver->axfr( 'example.com' ); while ( $rr = $iterator->() ) { $rr->print; } =head2 bgsend $handle = $resolver->bgsend( $packet ) || die $resolver->errorstring; $handle = $resolver->bgsend( 'mailhost.example.com' ); $handle = $resolver->bgsend( '192.0.2.1' ); $handle = $resolver->bgsend( 'example.com', 'MX' ); $handle = $resolver->bgsend( 'annotation.example.com', 'TXT', 'IN' ); Performs a background DNS query for the given name and returns immediately without waiting for the response. The program can then perform other tasks while awaiting the response from the nameserver. The argument list can be either a C object or a list of strings. The record type and class can be omitted; they default to A and IN. If the name looks like an IP address (IPv4 or IPv6), then a query within in-addr.arpa or ip6.arpa will be performed. Returns an opaque handle which is passed to subsequent invocations of the C and C methods. Errors are indicated by returning C in which case the reason for failure may be determined using errorstring(). The program may determine when the handle is ready for reading by calling C. The response C object is obtained by calling C. B: Programs should make no assumptions about the nature of the handles returned by C which should be used strictly as described here. =head2 bgread $packet = $resolver->bgread($handle); Reads the answer from a background query. The argument is the handle returned by C. Returns a C object or C if no response was received or timeout occurred. =head2 bgbusy $handle = $resolver->bgsend( 'foo.example.com' ); while ($resolver->bgbusy($handle)) { ... } $packet = $resolver->bgread($handle); Returns true while awaiting the response or for the transaction to time out. The argument is the handle returned by C. Truncated UDP packets will be retried over TCP transparently while continuing to assert busy to the caller. =head2 bgisready until ($resolver->bgisready($handle)) { ... } C is the logical complement of C which is retained for backward compatibility. =head2 debug print 'debug flag: ', $resolver->debug, "\n"; $resolver->debug(1); Get or set the debug flag. If set, calls to C, C, and C will print debugging information on the standard output. The default is false. =head2 defnames print 'defnames flag: ', $resolver->defnames, "\n"; $resolver->defnames(0); Get or set the defnames flag. If true, calls to C will append the default domain to names that contain no dots. The default is true. =head2 dnsrch print 'dnsrch flag: ', $resolver->dnsrch, "\n"; $resolver->dnsrch(0); Get or set the dnsrch flag. If true, calls to C will apply the search list to resolve names that are not fully qualified. The default is true. =head2 igntc print 'igntc flag: ', $resolver->igntc, "\n"; $resolver->igntc(1); Get or set the igntc flag. If true, truncated packets will be ignored. If false, the query will be retried using TCP. The default is false. =head2 nameservers @nameservers = $resolver->nameservers(); $resolver->nameservers( '192.0.2.1', '192.0.2.2', '2001:DB8::3' ); Gets or sets the nameservers to be queried. Also see the IPv6 transport notes below =head2 persistent_tcp print 'Persistent TCP flag: ', $resolver->persistent_tcp, "\n"; $resolver->persistent_tcp(1); Get or set the persistent TCP setting. If true, Net::DNS will keep a TCP socket open for each host:port to which it connects. This is useful if you are using TCP and need to make a lot of queries or updates to the same nameserver. The default is false unless you are running a SOCKSified Perl, in which case the default is true. =head2 persistent_udp print 'Persistent UDP flag: ', $resolver->persistent_udp, "\n"; $resolver->persistent_udp(1); Get or set the persistent UDP setting. If true, a Net::DNS resolver will use the same UDP socket for all queries within each address family. This avoids the cost of creating and tearing down UDP sockets, but also defeats source port randomisation. =head2 port print 'sending queries to port ', $resolver->port, "\n"; $resolver->port(9732); Gets or sets the port to which queries are sent. Convenient for nameserver testing using a non-standard port. The default is port 53. =head2 recurse print 'recursion flag: ', $resolver->recurse, "\n"; $resolver->recurse(0); Get or set the recursion flag. If true, this will direct nameservers to perform a recursive query. The default is true. =head2 retrans print 'retrans interval: ', $resolver->retrans, "\n"; $resolver->retrans(3); Get or set the retransmission interval The default is 5 seconds. =head2 retry print 'number of tries: ', $resolver->retry, "\n"; $resolver->retry(2); Get or set the number of times to try the query. The default is 4. =head2 searchlist @searchlist = $resolver->searchlist; $resolver->searchlist( 'a.example', 'b.example', 'c.example' ); Gets or sets the resolver search list. =head2 srcaddr $resolver->srcaddr('192.0.2.1'); Sets the source address from which queries are sent. Convenient for forcing queries from a specific interface on a multi-homed host. The default is to use any local address. =head2 srcport $resolver->srcport(5353); Sets the port from which queries are sent. The default is 0, meaning any port. =head2 tcp_timeout print 'TCP timeout: ', $resolver->tcp_timeout, "\n"; $resolver->tcp_timeout(10); Get or set the TCP timeout in seconds. The default is 120 seconds (2 minutes). A timeout of C means indefinite. =head2 udp_timeout print 'UDP timeout: ', $resolver->udp_timeout, "\n"; $resolver->udp_timeout(10); Get or set the UDP timeout in seconds. The default is C, which means that the retry and retrans settings will be used to perform the retries until they exhausted. =head2 udppacketsize print "udppacketsize: ", $resolver->udppacketsize, "\n"; $resolver->udppacketsize(2048); udppacketsize will set or get the packet size. If set to a value greater than the default DNS packet size, an EDNS extension will be added indicating support for UDP fragment reassembly. =head2 usevc print 'usevc flag: ', $resolver->usevc, "\n"; $resolver->usevc(1); Get or set the usevc flag. If true, queries will be performed using virtual circuits (TCP) instead of datagrams (UDP). The default is false. =head2 answerfrom print 'last answer was from: ', $resolver->answerfrom, "\n"; Returns the IP address from which the most recent packet was received in response to a query. =head2 answersize print 'size of last answer: ', $resolver->answersize, "\n"; Returns the size in bytes of the most recent packet received in response to a query. =head2 errorstring print 'query status: ', $resolver->errorstring, "\n"; Returns a string containing error information from the most recent method call. errorstring() is meaningful only when interrogated immediately after an error. =head2 dnssec print "dnssec flag: ", $resolver->dnssec, "\n"; $resolver->dnssec(0); The dnssec flag causes the resolver to transmit DNSSEC queries and to add a EDNS0 record as required by RFC2671 and RFC3225. The actions of, and response from, the remote nameserver is determined by the settings of the AD and CD flags. Calling the dnssec() method with a non-zero value will also set the UDP packet size to the default value of 2048. If that is too small or too big for your environment, you should call the udppacketsize() method immediately after. $resolver->dnssec(1); # DNSSEC using default packetsize $resolver->udppacketsize(1250); # lower the UDP packet size A fatal exception will be raised if the dnssec() method is called but the Net::DNS::SEC library has not been installed. =head2 adflag $resolver->dnssec(1); $resolver->adflag(1); print "authentication desired flag: ", $resolver->adflag, "\n"; Gets or sets the AD bit for dnssec queries. This bit indicates that the caller is interested in the returned AD (authentic data) bit but does not require any dnssec RRs to be included in the response. The default value is 0. =head2 cdflag $resolver->dnssec(1); $resolver->cdflag(1); print "checking disabled flag: ", $resolver->cdflag, "\n"; Gets or sets the CD bit for dnssec queries. This bit indicates that authentication by upstream nameservers should be suppressed. Any dnssec RRs required to execute the authentication procedure should be included in the response. The default value is 0. =head2 tsig $resolver->tsig( $tsig ); $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' ); $resolver->tsig( 'Khmac-sha1.example.+161+24053.key' ); $resolver->tsig( 'Khmac-sha1.example.+161+24053.key', fudge => 60 ); $resolver->tsig( $key_name, $key ); $resolver->tsig( undef ); Set the TSIG record used to automatically sign outgoing queries, zone transfers and updates. Automatic signing is disabled if called with undefined arguments. The default resolver behaviour is not to sign any packets. You must call this method to set the key if you would like the resolver to sign and verify packets automatically. Packets can also be signed manually; see the L and L manual pages for examples. TSIG records in manually-signed packets take precedence over those that the resolver would add automatically. =head1 ENVIRONMENT The following environment variables can also be used to configure the resolver: =head2 RES_NAMESERVERS # Bourne Shell RES_NAMESERVERS="192.0.2.1 192.0.2.2 2001:DB8::3" export RES_NAMESERVERS # C Shell setenv RES_NAMESERVERS "192.0.2.1 192.0.2.2 2001:DB8::3" A space-separated list of nameservers to query. =head2 RES_SEARCHLIST # Bourne Shell RES_SEARCHLIST="a.example.com b.example.com c.example.com" export RES_SEARCHLIST # C Shell setenv RES_SEARCHLIST "a.example.com b.example.com c.example.com" A space-separated list of domains to put in the search list. =head2 LOCALDOMAIN # Bourne Shell LOCALDOMAIN=example.com export LOCALDOMAIN # C Shell setenv LOCALDOMAIN example.com The default domain. =head2 RES_OPTIONS # Bourne Shell RES_OPTIONS="retrans:3 retry:2 inet6" export RES_OPTIONS # C Shell setenv RES_OPTIONS "retrans:3 retry:2 inet6" A space-separated list of resolver options to set. Options that take values are specified as C. =head1 IPv6 TRANSPORT The Net::DNS::Resolver library will enable IPv6 transport if the appropriate libraries (IO::Socket::IP or IO::Socket::INET6) are available and the destination nameserver has an IPv6 address. The force_v4(), force_v6(), prefer_v4 and prefer_v6() methods with a non-zero argument may be used to configure transport selection. The behaviour of the nameserver() method illustrates the transport selection mechanism. If, for example, IPv6 is not available or IPv4 transport has been forced, the nameserver() method will only return IPv4 addresses: $resolver->nameservers( '192.0.2.1', '192.0.2.2', '2001:DB8::3' ); $resolver->force_v4(1); print join ' ', $resolver->nameservers(); will print 192.0.2.1 192.0.2.2 =head1 CUSTOMISED RESOLVERS Net::DNS::Resolver is actually an empty subclass. At compile time a super class is chosen based on the current platform. A side benefit of this allows for easy modification of the methods in Net::DNS::Resolver. You can simply add a method to the namespace! For example, if we wanted to cache lookups: package Net::DNS::Resolver; my %cache; sub search { $self = shift; $cache{"@_"} ||= $self->SUPER::search(@_); } =head1 COPYRIGHT Copyright (c)1997-2000 Michael Fuhr. Portions Copyright (c)2002-2004 Chris Reinhardt. Portions Copyright (c)2005 Olaf M. Kolkman, NLnet Labs. Portions Copyright (c)2014,2015 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, L, L, L, L, RFC 1034, RFC 1035 =cut Net-DNS-1.07/lib/Net/DNS/Domain.pm0000644000175000017500000002342513031240164015642 0ustar willemwillempackage Net::DNS::Domain; # # $Id: Domain.pm 1456 2016-02-17 13:34:00Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1456 $)[1]; =head1 NAME Net::DNS::Domain - DNS domains =head1 SYNOPSIS use Net::DNS::Domain; $domain = new Net::DNS::Domain('example.com'); $name = $domain->name; =head1 DESCRIPTION The Net::DNS::Domain module implements a class of abstract DNS domain objects with associated class and instance methods. Each domain object instance represents a single DNS domain which has a fixed identity throughout its lifetime. Internally, the primary representation is a (possibly empty) list of ASCII domain name labels, and optional link to an arbitrary origin domain object topologically closer to the DNS root. The computational expense of Unicode character-set conversion is partially mitigated by use of caches. =cut use strict; use integer; use Carp; use constant ASCII => ref eval { require Encode; Encode::find_encoding('ascii'); # encoding object }; use constant LIBUTF8 => scalar eval { Encode::decode_utf8( chr(91) ) eq '['; # not UTF-EBCDIC [see UTR#16 3.6] }; use constant UTF8 => ref eval { LIBUTF8 && Encode::find_encoding('utf8'); # encoding object }; use constant LIBIDN => UTF8 && defined eval 'require Net::LibIDN'; # perlcc: address of encoding objects must be determined at runtime my $ascii = ASCII ? Encode::find_encoding('ascii') : undef; # Osborn's Law: my $utf8 = UTF8 ? Encode::find_encoding('utf8') : undef; # Variables won't; constants aren't. =head1 METHODS =head2 new $object = new Net::DNS::Domain('example.com'); Creates a domain object which represents the DNS domain specified by the character string argument. The argument consists of a sequence of labels delimited by dots. A character preceded by \ represents itself, without any special interpretation. Arbitrary 8-bit codes can be represented by \ followed by exactly three decimal digits. Character code points are ASCII, irrespective of the character coding scheme employed by the underlying platform. Argument string literals should be delimited by single quotes to avoid escape sequences being interpreted as octal character codes by the Perl compiler. The character string presentation format follows the conventions for zone files described in RFC1035. =cut use vars qw($ORIGIN); my ( $cache1, $cache2, $limit ) = ( {}, {}, 100 ); sub new { my ( $class, $s ) = @_; croak 'domain identifier undefined' unless defined $s; my $k = join '', $s, $class, $ORIGIN || ''; # cache key my $cache = $$cache1{$k} ||= $$cache2{$k}; # two layer cache return $cache if defined $cache; ( $cache1, $cache2, $limit ) = ( {}, $cache1, 500 ) unless $limit--; # recycle cache my $self = bless {}, $class; $s =~ s/\\\\/\\092/g; # disguise escaped escape $s =~ s/\\\./\\046/g; # disguise escaped dot my $label = $self->{label} = $s eq '@' ? [] : [split /\056/, _encode_ascii($s)]; foreach my $l (@$label) { $l = _unescape($l) if $l =~ /\\/; croak 'empty domain label' unless my $size = length($l); ( substr( $l, 63 ) = '', carp 'domain label truncated' ) if $size > 63; } $$cache1{$k} = $self; # cache object reference return $self if $s =~ /\.$/; # fully qualified name $self->{origin} = $ORIGIN || return $self; # dynamically scoped $ORIGIN return $self; } =head2 name $name = $domain->name; Returns the domain name as a character string corresponding to the "common interpretation" to which RFC1034, 3.1, paragraph 9 alludes. Character escape sequences are used to represent a dot inside a domain name label and the escape character itself. Any non-printable code point is represented using the appropriate numerical escape sequence. =cut my $dot = '.'; sub name { my ($self) = @_; return $self->{name} if defined $self->{name}; return unless defined wantarray; my $lref = $self->{label}; my $head = _decode_ascii( join chr(46), map _escape($_), @$lref ); my $tail = $self->{origin} || return $self->{name} = $head || $dot; return $self->{name} = $tail->name unless length $head; my $suffix = $tail->name; return $self->{name} = $suffix eq $dot ? $head : join $dot, $head, $suffix; } =head2 fqdn @fqdn = $domain->fqdn; Returns a character string containing the fully qualified domain name, including the trailing dot. =cut sub fqdn { my $name = &name; return $name =~ /[$dot]$/o ? $name : $name . $dot; # append trailing dot } =head2 xname $xname = $domain->xname; Interprets an extended name containing Unicode domain name labels encoded as Punycode A-labels. Domain names containing Unicode characters are supported if the Net::LibIDN module is installed. =cut sub xname { my $name = &name; if ( LIBIDN && $name =~ /xn--/ ) { my $self = shift; return $self->{xname} if defined $self->{xname}; return $self->{xname} = $utf8->decode( Net::LibIDN::idn_to_unicode $name, 'utf-8' ); } return $name; } =head2 label @label = $domain->label; Identifies the domain by means of a list of domain labels. =cut sub label { my $self = shift; my @head = map _decode_ascii( _escape($_) ), @{$self->{label}}; my $tail = $self->{origin} || return (@head); return ( @head, $tail->label ); } =head2 string $string = $object->string; Returns a character string containing the fully qualified domain name as it appears in a zone file. Characters which are recognised by RFC1035 zone file syntax are represented by the appropriate escape sequence. =cut sub string { ( my $name = &name ) =~ s/(["'\$();@])/\\$1/; # escape special char return $name =~ /[$dot]$/o ? $name : $name . $dot; # append trailing dot } =head2 origin $create = origin Net::DNS::Domain( $ORIGIN ); $result = &$create( sub{ new Net::DNS::RR( 'mx MX 10 a' ); } ); $expect = new Net::DNS::RR( "mx.$ORIGIN. MX 10 a.$ORIGIN." ); Class method which returns a reference to a subroutine wrapper which executes a given constructor in a dynamically scoped context where relative names become descendents of the specified $ORIGIN. =cut my $placebo = sub { my $constructor = shift; &$constructor; }; sub origin { my ( $class, $name ) = @_; my $domain = defined $name ? new Net::DNS::Domain($name) : return $placebo; return sub { # closure w.r.t. $domain my $constructor = shift; local $ORIGIN = $domain; # dynamically scoped $ORIGIN &$constructor; } } ######################################## sub _decode_ascii { ## translate ASCII to perl string my $s = shift; # partial transliteration for non-ASCII character encodings $s =~ tr [\040-\176\000-\377] [ !"#$%&'()*+,-./0-9:;<=>?@A-Z\[\\\]^_`a-z{|}~?] unless ASCII; my $z = length substr $s, 0, 0; # pre-5.18 taint workaround return ASCII ? pack( "a* x$z", $ascii->decode($s) ) : $s; } sub _encode_ascii { ## translate perl string to ASCII my $s = shift; my $z = length substr $s, 0, 0; # pre-5.18 taint workaround if ( LIBIDN && $s =~ /[^\000-\177]/ ) { my $xn = Net::LibIDN::idn_to_ascii( $s, 'utf-8' ); croak 'invalid name' unless $xn; return pack "a* x$z", $xn; } # partial transliteration for non-ASCII character encodings $s =~ tr [ !"#$%&'()*+,-./0-9:;<=>?@A-Z\[\\\]^_`a-z{|}~\000-\377] [\040-\176\077] unless ASCII; return ASCII ? pack( "a* x$z", $ascii->encode($s) ) : $s; } my %esc = eval { ## precalculated ASCII escape table my %table; foreach ( 33 .. 126 ) { # ASCII printable $table{pack( 'C', $_ )} = pack 'C', $_; } # minimal character escapes foreach ( 46, 92 ) { # \. \\ $table{pack( 'C', $_ )} = pack 'C*', 92, $_; } foreach my $n ( 0 .. 32, 127 .. 255 ) { # \ddd my $codepoint = sprintf( '%03u', $n ); # partial transliteration for non-ASCII character encodings $codepoint =~ tr [0-9] [\060-\071]; $table{pack( 'C', $n )} = pack 'C a3', 92, $codepoint; } return %table; }; sub _escape { ## Insert escape sequences in string my $s = shift; $s =~ s/([^\055\101-\132\141-\172\060-\071])/$esc{$1}/eg; return $s; } my %unesc = eval { ## precalculated numeric escape table my %table; foreach my $n ( 0 .. 255 ) { my $key = sprintf( '%03u', $n ); # partial transliteration for non-ASCII character encodings $key =~ tr [0-9] [\060-\071]; $table{$key} = pack 'C*', $n, $n == 92 ? ($n) : (); } return %table; }; sub _unescape { ## Remove escape sequences in string my $s = shift; $s =~ s/\134([\060-\071]{3})/$unesc{$1}/eg; # numeric escape $s =~ s/\134(.)/$1/g; # character escape return $s; } 1; __END__ ######################################## =head1 BUGS Coding strategy is intended to avoid creating unnecessary argument lists and stack frames. This improves efficiency at the expense of code readability. Platform specific character coding features are conditionally compiled into the code. =head1 COPYRIGHT Copyright (c)2009-2011 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1034, RFC1035, RFC5891, Unicode Technical Report #16 =cut Net-DNS-1.07/lib/Net/DNS/Parameters.pm0000644000175000017500000002702513031240164016536 0ustar willemwillempackage Net::DNS::Parameters; # # $Id: Parameters.pm 1521 2016-12-19 15:42:18Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1521 $)[1]; ################################################ ## ## Domain Name System (DNS) Parameters ## (last updated 2016-12-09) ## ################################################ use strict; use integer; use Carp; use vars qw($DNSEXTLANG); ## draft-levine-dnsextlang $DNSEXTLANG = 'ARPA.'; use constant DNSEXTLANG => defined eval <<'END'; die 'preempt failure' if $^O =~ /cygwin|MSWin32/i; require FileHandle; local $SIG{__WARN__} = sub { }; new FileHandle('RRTYPEgen |'); END use base qw(Exporter); use vars qw(@EXPORT); @EXPORT = qw( classbyname classbyval %classbyname typebyname typebyval %typebyname opcodebyname opcodebyval rcodebyname rcodebyval ednsoptionbyname ednsoptionbyval ); # Registry: DNS CLASSes use vars qw( %classbyname %classbyval ); %classbyname = ( IN => 1, # RFC1035 CH => 3, # Chaosnet HS => 4, # Hesiod NONE => 254, # RFC2136 ANY => 255, # RFC1035 ); %classbyval = reverse %classbyname; %classbyname = ( '*' => 255, %classbyname, map lc($_), %classbyname ); # Registry: Resource Record (RR) TYPEs use vars qw( %typebyname %typebyval ); %typebyname = ( A => 1, # RFC1035 NS => 2, # RFC1035 MD => 3, # RFC1035 MF => 4, # RFC1035 CNAME => 5, # RFC1035 SOA => 6, # RFC1035 MB => 7, # RFC1035 MG => 8, # RFC1035 MR => 9, # RFC1035 NULL => 10, # RFC1035 WKS => 11, # RFC1035 PTR => 12, # RFC1035 HINFO => 13, # RFC1035 MINFO => 14, # RFC1035 MX => 15, # RFC1035 TXT => 16, # RFC1035 RP => 17, # RFC1183 AFSDB => 18, # RFC1183 RFC5864 X25 => 19, # RFC1183 ISDN => 20, # RFC1183 RT => 21, # RFC1183 NSAP => 22, # RFC1706 'NSAP-PTR' => 23, # RFC1348 RFC1637 RFC1706 SIG => 24, # RFC4034 RFC3755 RFC2535 RFC2536 RFC2537 RFC2931 RFC3110 RFC3008 KEY => 25, # RFC4034 RFC3755 RFC2535 RFC2536 RFC2537 RFC2539 RFC3008 RFC3110 PX => 26, # RFC2163 GPOS => 27, # RFC1712 AAAA => 28, # RFC3596 LOC => 29, # RFC1876 NXT => 30, # RFC3755 RFC2535 EID => 31, # http://ana-3.lcs.mit.edu/~jnc/nimrod/dns.txt NIMLOC => 32, # http://ana-3.lcs.mit.edu/~jnc/nimrod/dns.txt SRV => 33, # RFC2782 ATMA => 34, # http://www.broadband-forum.org/ftp/pub/approved-specs/af-dans-0152.000.pdf NAPTR => 35, # RFC2915 RFC2168 RFC3403 KX => 36, # RFC2230 CERT => 37, # RFC4398 A6 => 38, # RFC3226 RFC2874 RFC6563 DNAME => 39, # RFC6672 SINK => 40, # http://tools.ietf.org/html/draft-eastlake-kitchen-sink OPT => 41, # RFC6891 RFC3225 APL => 42, # RFC3123 DS => 43, # RFC4034 RFC3658 SSHFP => 44, # RFC4255 IPSECKEY => 45, # RFC4025 RRSIG => 46, # RFC4034 RFC3755 NSEC => 47, # RFC4034 RFC3755 DNSKEY => 48, # RFC4034 RFC3755 DHCID => 49, # RFC4701 NSEC3 => 50, # RFC5155 NSEC3PARAM => 51, # RFC5155 TLSA => 52, # RFC6698 SMIMEA => 53, # draft-ietf-dane-smime HIP => 55, # RFC8005 NINFO => 56, # RKEY => 57, # TALINK => 58, # CDS => 59, # RFC7344 CDNSKEY => 60, # RFC7344 OPENPGPKEY => 61, # RFC7929 CSYNC => 62, # RFC7477 SPF => 99, # RFC7208 UINFO => 100, # IANA-Reserved UID => 101, # IANA-Reserved GID => 102, # IANA-Reserved UNSPEC => 103, # IANA-Reserved NID => 104, # RFC6742 L32 => 105, # RFC6742 L64 => 106, # RFC6742 LP => 107, # RFC6742 EUI48 => 108, # RFC7043 EUI64 => 109, # RFC7043 TKEY => 249, # RFC2930 TSIG => 250, # RFC2845 IXFR => 251, # RFC1995 AXFR => 252, # RFC1035 RFC5936 MAILB => 253, # RFC1035 MAILA => 254, # RFC1035 ANY => 255, # RFC1035 RFC6895 URI => 256, # RFC7553 CAA => 257, # RFC6844 AVC => 258, # TA => 32768, # http://cameo.library.cmu.edu/ http://www.watson.org/~weiler/INI1999-19.pdf DLV => 32769, # RFC4431 ); %typebyval = reverse %typebyname; %typebyname = ( '*' => 255, %typebyname, map lc($_), %typebyname ); # Registry: DNS OpCodes use vars qw( %opcodebyname %opcodebyval ); %opcodebyname = ( QUERY => 0, # RFC1035 IQUERY => 1, # RFC3425 STATUS => 2, # RFC1035 NOTIFY => 4, # RFC1996 UPDATE => 5, # RFC2136 ); %opcodebyval = reverse %opcodebyname; %opcodebyname = ( NS_NOTIFY_OP => 4, %opcodebyname, map lc($_), %opcodebyname ); # Registry: DNS RCODEs use vars qw( %rcodebyname %rcodebyval ); %rcodebyname = ( NOERROR => 0, # RFC1035 FORMERR => 1, # RFC1035 SERVFAIL => 2, # RFC1035 NXDOMAIN => 3, # RFC1035 NOTIMP => 4, # RFC1035 REFUSED => 5, # RFC1035 YXDOMAIN => 6, # RFC2136 RFC6672 YXRRSET => 7, # RFC2136 NXRRSET => 8, # RFC2136 NOTAUTH => 9, # RFC2136 NOTAUTH => 9, # RFC2845 NOTZONE => 10, # RFC2136 BADVERS => 16, # RFC6891 BADSIG => 16, # RFC2845 BADKEY => 17, # RFC2845 BADTIME => 18, # RFC2845 BADMODE => 19, # RFC2930 BADNAME => 20, # RFC2930 BADALG => 21, # RFC2930 BADTRUNC => 22, # RFC4635 BADCOOKIE => 23, # RFC7873 ); %rcodebyval = reverse( BADSIG => 16, %rcodebyname ); %rcodebyname = ( %rcodebyname, map lc($_), %rcodebyname ); # Registry: DNS EDNS0 Option Codes (OPT) use vars qw( %ednsoptionbyname %ednsoptionbyval ); %ednsoptionbyname = ( LLQ => 1, # http://files.dns-sd.org/draft-sekar-dns-llq.txt UL => 2, # http://files.dns-sd.org/draft-sekar-dns-ul.txt NSID => 3, # RFC5001 DAU => 5, # RFC6975 DHU => 6, # RFC6975 N3U => 7, # RFC6975 'CLIENT-SUBNET' => 8, # RFC7871 EXPIRE => 9, # RFC7314 COOKIE => 10, # RFC7873 'TCP-KEEPALIVE' => 11, # RFC7828 PADDING => 12, # RFC7830 CHAIN => 13, # RFC7901 DEVICEID => 26946, # https://docs.umbrella.com/developer/networkdevices-api/identifying-dns-traffic2 ); %ednsoptionbyval = reverse %ednsoptionbyname; %ednsoptionbyname = ( %ednsoptionbyname, map lc($_), %ednsoptionbyname ); # Registry: DNS Header Flags use vars qw( %dnsflagbyname ); %dnsflagbyname = ( AA => 0x0400, # RFC1035 TC => 0x0200, # RFC1035 RD => 0x0100, # RFC1035 RA => 0x0080, # RFC1035 AD => 0x0020, # RFC4035 CD => 0x0010, # RFC4035 ); # Registry: EDNS Header Flags (16 bits) use vars qw( %ednsflagbyname ); %ednsflagbyname = ( DO => 0x8000, # RFC4035 RFC3225 ); ######## # The following functions are wrappers around similarly named hashes. sub classbyname { my $name = shift; $classbyname{$name} || $classbyname{uc $name} || do { croak "unknown class $name" unless $name =~ m/(CLASS)?(\d+)/i; my $val = 0 + $2; croak "classbyname( $name ) out of range" if $val > 0xffff; return $val; } } sub classbyval { my $val = shift; $classbyval{$val} || do { $val += 0; croak "classbyval( $val ) out of range" if $val > 0xffff; return "CLASS$val"; } } sub typebyname { my $name = shift; $typebyname{$name} || do { if ( $name =~ m/(TYPE)?(\d+)/i ) { my $val = 0 + $2; croak "typebyname( $name ) out of range" if $val > 0xffff; return $val; } _typespec("$name.RRNAME"); return $typebyname{uc $name} || croak "unknown type $name"; } } sub typebyval { my $val = shift; $typebyval{$val} || do { $val += 0; croak "typebyval( $val ) out of range" if $val > 0xffff; $typebyval{$val} = "TYPE$val"; _typespec("$val.RRTYPE"); return $typebyval{$val}; } } sub opcodebyname { my $arg = shift; return $opcodebyname{$arg} if defined $opcodebyname{$arg}; return 0 + $arg if $arg =~ /^\d/; croak "unknown opcode $arg"; } sub opcodebyval { my $val = shift; $opcodebyval{$val} || return $val; } sub rcodebyname { my $arg = shift; return $rcodebyname{$arg} if defined $rcodebyname{$arg}; return 0 + $arg if $arg =~ /^\d/; croak "unknown rcode $arg"; } sub rcodebyval { my $val = shift; $rcodebyval{$val} || return $val; } sub ednsoptionbyname { my $arg = shift; return $ednsoptionbyname{$arg} if defined $ednsoptionbyname{$arg}; return 0 + $arg if $arg =~ /^\d/; croak "unknown option $arg"; } sub ednsoptionbyval { my $val = shift; $ednsoptionbyval{$val} || return $val; } sub register { ## register( 'TOY', 1234 ) (NOT part of published API) my ( $mnemonic, $rrtype ) = map uc($_), @_; # uncoverable pod $rrtype = rand(255) + 65280 unless $rrtype; for ( typebyval $rrtype = int($rrtype) ) { croak "'$mnemonic' is a CLASS identifier" if $classbyname{$mnemonic}; return $rrtype if /^$mnemonic$/; # duplicate registration croak "'$mnemonic' conflicts with TYPE$rrtype ($_)" unless /^TYPE\d+$/; my $known = $typebyname{$mnemonic}; croak "'$mnemonic' conflicts with TYPE$known" if $known; } $typebyval{$rrtype} = $mnemonic; return $typebyname{$mnemonic} = $rrtype; } sub _typespec { ## draft-levine-dnsextlang eval <<'END' if DNSEXTLANG; my ($node) = @_; require Net::DNS::Resolver; my $resolver = new Net::DNS::Resolver; my $response = $resolver->send( "$node.$DNSEXTLANG", 'TXT' ); foreach my $txt ( grep $_->type eq 'TXT', $response->answer ) { my @stanza = $txt->txtdata; my ( $tag, $identifier ) = @stanza; next unless defined($tag) && $tag =~ /^RRTYPE=\d+$/; register( split /[:\s]/, $identifier ); return unless defined wantarray; require 5.008009; # support for reference in @INC my @arg = map { s/\s.*$//; qq("$_") } @stanza; # strip descriptive text return new FileHandle("RRTYPEgen @arg |"); } return undef; END } 1; __END__ =head1 NAME Net::DNS::Parameters - DNS parameter assignments =head1 SYNOPSIS use Net::DNS::Parameters; =head1 DESCRIPTION Net::DNS::Parameters is a Perl package representing the DNS parameter allocation (key,value) tables as recorded in the definitive registry maintained and published by IANA. =head1 FUNCTIONS =head2 classbyname, typebyname, opcodebyname, rcodebyname, ednsoptionbyname Access functions which return the numerical code corresponding to the given mnemonic. =head2 classbyval, typebyval, opcodebyval, rcodebyval, ednsoptionbyval Access functions which return the canonical mnemonic corresponding to the given numerical code. =head1 COPYRIGHT Copyright (c)2012,2016 Dick Franks. Portions Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2003 Olaf Kolkman. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L =cut Net-DNS-1.07/lib/Net/DNS/Header.pm0000644000175000017500000002416513031240164015625 0ustar willemwillempackage Net::DNS::Header; # # $Id: Header.pm 1381 2015-08-25 07:36:09Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1381 $)[1]; =head1 NAME Net::DNS::Header - DNS packet header =head1 SYNOPSIS use Net::DNS; $packet = new Net::DNS::Packet; $header = $packet->header; =head1 DESCRIPTION C represents the header portion of a DNS packet. =cut use strict; use integer; use Carp; use Net::DNS::Parameters; =head1 METHODS =head2 $packet->header $packet = new Net::DNS::Packet; $header = $packet->header; Net::DNS::Header objects emanate from the Net::DNS::Packet header() method, and contain an opaque reference to the parent Packet object. Header objects may be assigned to suitably scoped lexical variables. They should never be stored in global variables or persistent data structures. =head2 string print $packet->header->string; Returns a string representation of the packet header. =cut sub string { my $self = shift; my $id = $self->id; my $qr = $self->qr; my $opcode = $self->opcode; my $rcode = $self->rcode; my $qd = $self->qdcount; my $an = $self->ancount; my $ns = $self->nscount; my $ar = $self->arcount; my $opt = $$self->edns; my $edns = $opt->_specified ? $opt->string : ''; return <aa; my $tc = $self->tc; my $rd = $self->rd; my $ra = $self->ra; my $zz = $self->z; my $ad = $self->ad; my $cd = $self->cd; my $do = $self->do; return <header->print; Prints the string representation of the packet header. =cut sub print { print &string; } =head2 id print "query id = ", $packet->header->id, "\n"; $packet->header->id(1234); Gets or sets the query identification number. A random value is assigned if the argument value is undefined. =cut sub id { my $self = shift; $$self->{id} = shift if scalar @_; return $$self->{id} if defined $$self->{id}; $$self->{id} = int rand(0xffff); } =head2 opcode print "query opcode = ", $packet->header->opcode, "\n"; $packet->header->opcode("UPDATE"); Gets or sets the query opcode (the purpose of the query). =cut sub opcode { my $self = shift; for ( $$self->{status} ) { return opcodebyval( ( $_ >> 11 ) & 0x0f ) unless scalar @_; my $opcode = opcodebyname(shift); $_ = ( $_ & 0x87ff ) | ( $opcode << 11 ); return $opcode; } } =head2 rcode print "query response code = ", $packet->header->rcode, "\n"; $packet->header->rcode("SERVFAIL"); Gets or sets the query response code (the status of the query). =cut sub rcode { my $self = shift; for ( $$self->{status} ) { my $arg = shift; my $opt = $$self->edns; unless ( defined $arg ) { my $rcode = $opt->rcode; return rcodebyval( $_ & 0x0f ) unless $opt->_specified; $rcode = ( $rcode & 0xff0 ) | ( $_ & 0x00f ); $opt->rcode($rcode); # write back full 12-bit rcode return $rcode == 16 ? 'BADVERS' : rcodebyval($rcode); } my $rcode = rcodebyname($arg); $opt->rcode($rcode); # full 12-bit rcode $_ &= 0xfff0; # low 4-bit rcode $_ |= ( $rcode & 0x000f ); return $rcode; } } =head2 qr print "query response flag = ", $packet->header->qr, "\n"; $packet->header->qr(0); Gets or sets the query response flag. =cut sub qr { shift->_dnsflag( 0x8000, @_ ); } =head2 aa print "answer is ", $packet->header->aa ? "" : "non-", "authoritative\n"; $packet->header->aa(0); Gets or sets the authoritative answer flag. =cut sub aa { shift->_dnsflag( 0x0400, @_ ); } =head2 tc print "packet is ", $packet->header->tc ? "" : "not ", "truncated\n"; $packet->header->tc(0); Gets or sets the truncated packet flag. =cut sub tc { shift->_dnsflag( 0x0200, @_ ); } =head2 rd print "recursion was ", $packet->header->rd ? "" : "not ", "desired\n"; $packet->header->rd(0); Gets or sets the recursion desired flag. =cut sub rd { shift->_dnsflag( 0x0100, @_ ); } =head2 ra print "recursion is ", $packet->header->ra ? "" : "not ", "available\n"; $packet->header->ra(0); Gets or sets the recursion available flag. =cut sub ra { shift->_dnsflag( 0x0080, @_ ); } =head2 z Unassigned bit, should always be zero. =cut sub z { shift->_dnsflag( 0x0040, @_ ); } =head2 ad print "The result has ", $packet->header->ad ? "" : "not", "been verified\n"; Relevant in DNSSEC context. (The AD bit is only set on answers where signatures have been cryptographically verified or the server is authoritative for the data and is allowed to set the bit by policy.) =cut sub ad { shift->_dnsflag( 0x0020, @_ ); } =head2 cd print "checking was ", $packet->header->cd ? "not" : "", "desired\n"; $packet->header->cd(0); Gets or sets the checking disabled flag. =cut sub cd { shift->_dnsflag( 0x0010, @_ ); } =head2 qdcount, zocount print "# of question records: ", $packet->header->qdcount, "\n"; Returns the number of records in the question section of the packet. In dynamic update packets, this field is known as C and refers to the number of RRs in the zone section. =cut use vars qw($warned); sub qdcount { my $self = shift; return $$self->{count}[0] || scalar @{$$self->{question}} unless scalar @_; carp 'header->qdcount attribute is read-only' unless $warned++; } =head2 ancount, prcount print "# of answer records: ", $packet->header->ancount, "\n"; Returns the number of records in the answer section of the packet which may, in the case of corrupt packets, differ from the actual number of records. In dynamic update packets, this field is known as C and refers to the number of RRs in the prerequisite section. =cut sub ancount { my $self = shift; return $$self->{count}[1] || scalar @{$$self->{answer}} unless scalar @_; carp 'header->ancount attribute is read-only' unless $warned++; } =head2 nscount, upcount print "# of authority records: ", $packet->header->nscount, "\n"; Returns the number of records in the authority section of the packet which may, in the case of corrupt packets, differ from the actual number of records. In dynamic update packets, this field is known as C and refers to the number of RRs in the update section. =cut sub nscount { my $self = shift; return $$self->{count}[2] || scalar @{$$self->{authority}} unless scalar @_; carp 'header->nscount attribute is read-only' unless $warned++; } =head2 arcount, adcount print "# of additional records: ", $packet->header->arcount, "\n"; Returns the number of records in the additional section of the packet which may, in the case of corrupt packets, differ from the actual number of records. In dynamic update packets, this field is known as C. =cut sub arcount { my $self = shift; return $$self->{count}[3] || scalar @{$$self->{additional}} unless scalar @_; carp 'header->arcount attribute is read-only' unless $warned++; } sub zocount { &qdcount; } sub prcount { &ancount; } sub upcount { &nscount; } sub adcount { &arcount; } =head1 EDNS Protocol Extensions =head2 do print "DNSSEC_OK flag was ", $packet->header->do ? "not" : "", "set\n"; $packet->header->do(1); Gets or sets the EDNS DNSSEC OK flag. =cut sub do { shift->_ednsflag( 0x8000, @_ ); } =head2 Extended rcode EDNS extended rcodes are handled transparently by $packet->header->rcode(). =head2 UDP packet size $udp_max = $packet->header->size; $udp_max = $packet->edns->size; EDNS offers a mechanism to advertise the maximum UDP packet size which can be assembled by the local network stack. UDP size advertisement can be viewed as either a header extension or an EDNS feature. Endless debate is avoided by supporting both views. =cut sub size { my $self = shift; return $$self->edns->size(@_); } =head2 edns $header = $packet->header; $version = $header->edns->version; @options = $header->edns->options; $option = $header->edns->option(n); $udp_max = $packet->edns->size; Auxiliary function which provides access to the EDNS protocol extension OPT RR. =cut sub edns { my $self = shift; return $$self->edns; } ######################################## sub _dnsflag { my $self = shift; my $flag = shift; for ( $$self->{status} ) { my $set = $_ | $flag; my $not = $set - $flag; $_ = (shift) ? $set : $not if scalar @_; return ( $_ & $flag ) ? 1 : 0; } } sub _ednsflag { my $self = shift; my $flag = shift; my $edns = $$self->edns->flags || 0; return $flag & $edns ? 1 : 0 unless scalar @_; my $set = $flag | $edns; my $not = $set - $flag; my $new = (shift) ? $set : $not; $$self->edns->flags($new) unless $new == $edns; return ( $new & $flag ) ? 1 : 0; } 1; __END__ ######################################## =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. Portions Copyright (c)2012 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L RFC 1035 Section 4.1.1 =cut Net-DNS-1.07/lib/Net/DNS/ZoneFile.pm0000644000175000017500000003710713031240164016150 0ustar willemwillempackage Net::DNS::ZoneFile; # # $Id: ZoneFile.pm 1510 2016-10-11 12:29:10Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1510 $)[1]; =head1 NAME Net::DNS::ZoneFile - DNS zone file =head1 SYNOPSIS use Net::DNS::ZoneFile; $zonefile = new Net::DNS::ZoneFile( 'named.example' ); while ( $rr = $zonefile->read ) { $rr->print; } @zone = $zonefile->read; =head1 DESCRIPTION Each Net::DNS::ZoneFile object instance represents a zone file together with any subordinate files introduced by the $INCLUDE directive. Zone file syntax is defined by RFC1035. A program may have multiple zone file objects, each maintaining its own independent parser state information. The parser supports both the $TTL directive defined by RFC2308 and the BIND $GENERATE syntax extension. All RRs in a zone file must have the same class, which may be specified for the first RR encountered and is then propagated automatically to all subsequent records. =cut use strict; use integer; use Carp; use FileHandle; use constant PERLIO => defined eval 'require PerlIO'; require Net::DNS::Domain; require Net::DNS::RR; =head1 METHODS =head2 new $zonefile = new Net::DNS::ZoneFile( 'filename', ['example.com'] ); $handle = new FileHandle( 'filename', '<:encoding(ISO8859-7)' ); $zonefile = new Net::DNS::ZoneFile( $handle, ['example.com'] ); The new() constructor returns a Net::DNS::ZoneFile object which represents the zone file specified in the argument list. The specified file or file handle is open for reading and closed when exhausted or all references to the ZoneFile object cease to exist. The optional second argument specifies $ORIGIN for the zone file. Character encoding is specified indirectly by creating a FileHandle with the desired encoding layer, which is then passed as an argument to new(). The specified encoding is propagated to files introduced by $include directives. =cut sub new { my $self = bless {}, shift; my $file = shift; $self->_origin(shift); if ( ref($file) ) { $self->{filename} = $self->{handle} = $file; $self->{fileopen} = {}; return $self if ref($file) =~ /FileHandle|IO::File|GLOB|Text/; croak 'argument not a file handle'; } $self->{filename} = $file ||= ''; $self->{handle} = new FileHandle($file) or croak qq($! "$file"); $self->{fileopen}{$file}++; return $self; } =head2 read $rr = $zonefile->read; @rr = $zonefile->read; When invoked in scalar context, read() returns a Net::DNS::RR object representing the next resource record encountered in the zone file, or undefined if end of data has been reached. When invoked in list context, read() returns the list of Net::DNS::RR objects in the order that they appear in the zone file. Comments and blank lines are silently disregarded. $INCLUDE, $ORIGIN, $TTL and $GENERATE directives are processed transparently. =cut sub read { my ($self) = @_; return &_read unless ref $self; # compatibility interface local $SIG{__DIE__}; if (wantarray) { my @zone; # return entire zone eval { my $rr; push( @zone, $rr ) while $rr = $self->_getRR; }; croak join ' ', $@, ' file', $self->name, 'line', $self->line, "\n " if $@; return @zone; } my $rr = eval { $self->_getRR }; # return single RR croak join ' ', $@, ' file', $self->name, 'line', $self->line, "\n " if $@; return $rr; } =head2 name $filename = $zonefile->name; Returns the name of the current zone file. Embedded $INCLUDE directives will cause this to differ from the filename argument supplied when the object was created. =cut sub name { return shift->{filename}; } =head2 line $line = $zonefile->line; Returns the number of the last line read from the current zone file. =cut sub line { my $self = shift; return $self->{eom} if defined $self->{eom}; return $self->{handle}->input_line_number; } =head2 origin $origin = $zonefile->origin; Returns the fully qualified name of the current origin within the zone file. =cut sub origin { my $context = shift->{context}; return &$context( sub { new Net::DNS::Domain('@') } )->string; } =head2 ttl $ttl = $zonefile->ttl; Returns the default TTL as specified by the $TTL directive. =cut sub ttl { return shift->{TTL}; } =head1 COMPATIBILITY WITH Net::DNS::ZoneFile 1.04 Applications which depended on the defunct Net::DNS::ZoneFile 1.04 CPAN distribution will continue to operate with minimal change using the compatibility interface described below. use Net::DNS::ZoneFile; $listref = Net::DNS::ZoneFile->read( $filename ); $listref = Net::DNS::ZoneFile->read( $filename, $include_dir ); $listref = Net::DNS::ZoneFile->readfh( $handle, $include_dir ); $listref = Net::DNS::ZoneFile->parse( $string ); $listref = Net::DNS::ZoneFile->parse( $string, $include_dir ); $listref = Net::DNS::ZoneFile->parse( \$string, $include_dir ); $_->print for @$listref; The optional second argument specifies the default path for filenames. The current working directory is used by default. Although not available in the original implementation, the RR list can be obtained directly by calling any of these methods in list context. @rr = Net::DNS::ZoneFile->read( $filename, $include_dir ); =head2 read $listref = Net::DNS::ZoneFile->read( $filename, $include_dir ); @rr = Net::DNS::ZoneFile->read( $filename, $include_dir ); read() parses the specified zone file and returns a reference to the list of Net::DNS::RR objects representing the RRs in the file. The return value is undefined if the zone data can not be parsed. When called in list context, the partial result is returned if an error is encountered by the parser. =cut use vars qw($include_dir); ## dynamically scoped sub _filename { ## rebase unqualified filename my $name = shift; return $name if ref($name); ## file handle return $name unless $include_dir; require File::Spec; return $name if File::Spec->file_name_is_absolute($name); return $name if -f $name; return File::Spec->catfile( $include_dir, $name ); } sub _read { my ($arg1) = @_; shift if !ref($arg1) && $arg1 eq __PACKAGE__; my $filename = shift; local $include_dir = shift; my $zonefile = new Net::DNS::ZoneFile( _filename($filename) ); my @zone; eval { local $SIG{__DIE__}; my $rr; push( @zone, $rr ) while $rr = $zonefile->_getRR; }; return wantarray ? @zone : \@zone unless $@; carp $@; return wantarray ? @zone : undef; } { package Net::DNS::ZoneFile::Text; use overload ( '<>' => 'readline' ); use constant OVERLOAD_OK => scalar eval 'no integer; $] > 5.006'; sub new { my $self = bless {}, shift; my $data = shift; $self->{data} = [split /\n/, ref($data) ? $$data : $data]; return OVERLOAD_OK ? $self : do { # Plan B require IO::File; my $fh = IO::File->new_tmpfile() or die "$!"; while ( my $line = $self->readline ) { print $fh $line, "\n"; } seek $fh, 0, 0; return $fh; }; } sub readline { my $self = shift; $self->{line}++; return shift( @{$self->{data}} ); } sub close { shift->{data} = []; return 1; } sub input_line_number { return shift->{line}; } } =head2 readfh $listref = Net::DNS::ZoneFile->readfh( $handle, $include_dir ); readfh() parses data from the specified file handle and returns a reference to the list of Net::DNS::RR objects representing the RRs in the file. =cut sub readfh { return &_read; } =head2 parse $listref = Net::DNS::ZoneFile->parse( $string, $include_dir ); $listref = Net::DNS::ZoneFile->parse( \$string, $include_dir ); parse() interprets the zone file text in the argument string and returns a reference to the list of Net::DNS::RR objects representing the RRs. =cut sub parse { my ($text) = reverse @_; return &readfh( new Net::DNS::ZoneFile::Text($text), @_ ); } ######################################## { package Net::DNS::ZoneFile::Generator; use overload ( '<>' => 'readline' ); use constant OVERLOAD_OK => scalar eval 'no integer; $] > 5.006'; sub new { my $self = bless {}, shift; my ( $range, $template, $line ) = @_; $template =~ s/\\\$/\\036/g; # disguise escaped dollar $template =~ s/\$\$/\\036/g; # disguise escaped dollar my ( $bound, $step ) = split m#[/]#, $range; # initial iterator state my ( $first, $last ) = split m#[-]#, $bound; $first ||= 0; $last ||= $first; $step = abs( $step || 1 ); # coerce step to match range $step = -$step if $last < $first; $self->{count} = int( ( $last - $first ) / $step ) + 1; @{$self}{qw(instant step template line)} = ( $first, $step, $template, $line ); return OVERLOAD_OK ? $self : do { # Plan B require IO::File; my $fh = IO::File->new_tmpfile() or die "$!"; while ( my $line = $self->readline ) { print $fh $line, "\n"; } seek $fh, 0, 0; return $fh; }; } sub readline { my $self = shift; return undef unless $self->{count}-- > 0; # EOF my $instant = $self->{instant}; # update iterator state $self->{instant} += $self->{step}; local $_ = $self->{template}; # copy template while (/\$\{(.*)\}/) { # interpolate ${...} my $s = _format( $instant, split /\,/, $1 ); s/\$\{$1\}/$s/eg; } s/\$/$instant/eg; # interpolate $ return $_; } sub close { shift->{count} = 0; # suppress iterator return 1; } sub input_line_number { return shift->{line}; # fixed: identifies $GENERATE } sub _format { ## convert $GENERATE iteration number to specified format my $number = shift; # per ISC BIND 9.7 my $offset = shift || 0; my $length = shift || 0; my $format = shift || 'd'; my $value = $number + $offset; my $digit = $length || 1; return substr sprintf( "%01.$digit$format", $value ), -$length if $format =~ /[doxX]/; my $nibble = join( '.', split //, sprintf ".%32.32lx", $value ); return lc reverse substr $nibble, -$length if $format =~ /[n]/; return uc reverse substr $nibble, -$length if $format =~ /[N]/; die "unknown $format format"; } } sub _generate { ## expand $GENERATE into input stream my ( $self, $range, $template ) = @_; my $handle = new Net::DNS::ZoneFile::Generator( $range, $template, $self->line ); delete $self->{latest}; # forget previous owner $self->{parent} = bless {%$self}, ref($self); # save state, create link $self->{handle} = $handle; } my $LEX_REGEX = q/("[^"]*"|"[^"]*$)|;[^\n]*|([()])|(^\s)|[ \t\n\r\f]/; sub _getline { ## get line from current source my $self = shift; my $fh = $self->{handle}; while (<$fh>) { next if /^\s*;/; # discard comment line next unless /\S/; # discard blank line if (/[(]/) { # concatenate multi-line RR s/\\\\/\\092/g; # disguise escaped escape s/\\"/\\034/g; # disguise escaped quote s/\\\(/\\040/g; # disguise escaped bracket s/\\\)/\\041/g; # disguise escaped bracket s/\\;/\\059/g; # disguise escaped semicolon my @token = grep defined && length, split /$LEX_REGEX/o; if ( grep( $_ eq '(', @token ) && !grep( $_ eq ')', @token ) ) { while (<$fh>) { $_ = pop(@token) . $_; # splice fragmented string s/\\\\/\\092/g; # disguise escaped escape s/\\"/\\034/g; # disguise escaped quote s/\\\(/\\040/g; # disguise escaped bracket s/\\\)/\\041/g; # disguise escaped bracket s/\\;/\\059/g; # disguise escaped semicolon my @part = grep defined && length, split /$LEX_REGEX/o; push @token, @part; last if grep $_ eq ')', @part; } $_ = join ' ', @token; # reconstitute RR string } } return $_ unless /^\$/; # RR string if (/^\$INCLUDE/) { # directive my ( $keyword, @argument ) = split; die '$INCLUDE incomplete' unless @argument; $fh = $self->_include(@argument); } elsif (/^\$GENERATE/) { # directive my ( $keyword, $range, @template ) = split; die '$GENERATE incomplete' unless $range; $fh = $self->_generate( $range, "@template\n" ); } elsif (/^\$ORIGIN/) { # directive my ( $keyword, $origin, @etc ) = split; die '$ORIGIN incomplete' unless $origin; my $context = $self->{context}; &$context( sub { $self->_origin($origin); } ); } elsif (/^\$TTL/) { # directive my ( $keyword, $ttl, @etc ) = split; die '$TTL incomplete' unless defined $ttl; $self->{TTL} = Net::DNS::RR::ttl( {}, $ttl ); } else { # unrecognised my ($keyword) = split; die "unknown '$keyword' directive"; } } $self->{eom} = $self->line; # end of file $fh->close(); my $link = $self->{parent} || return undef; # end of zone %$self = %$link; # end $INCLUDE $self->_getline; # resume input } sub _getRR { ## get RR from current source my $self = shift; local $_; $self->_getline || return undef; # line already in $_ my $noname = s/^\s/\@\t/; # placeholder for empty RR name # construct RR object with context specific dynamically scoped $ORIGIN my $context = $self->{context}; my $rr = &$context( sub { Net::DNS::RR->_new_string($_) } ); my $latest = $self->{latest}; # overwrite placeholder $rr->{owner} = $latest->{owner} if $noname && $latest; $self->{class} = $rr->class unless $self->{class}; # propagate RR class $rr->class( $self->{class} ); $self->{TTL} ||= $rr->minimum if $rr->type eq 'SOA'; # default TTL $rr->{'ttl'} = $self->{TTL} unless defined $rr->{'ttl'}; return $self->{latest} = $rr; } sub _include { ## open $INCLUDE file my $self = shift; my $file = _filename(shift); my $root = shift; my $opened = {%{$self->{fileopen}}}; croak qq(recursive \$INCLUDE $file) if $opened->{$file}++; my @discipline = PERLIO ? ( join ':', '<', PerlIO::get_layers $self->{handle} ) : (); my $handle = new FileHandle( $file, @discipline ) or croak qq($! "$file"); delete $self->{latest}; # forget previous owner $self->{parent} = bless {%$self}, ref($self); # save state, create link $self->{context} = origin Net::DNS::Domain($root) if $root; $self->{filename} = $file; $self->{fileopen} = $opened; return $self->{handle} = $handle; } sub _origin { ## change $ORIGIN (scope: current file) my $self = shift; $self->{context} = origin Net::DNS::Domain(shift); delete $self->{latest}; # forget previous owner } 1; __END__ =head1 ACKNOWLEDGEMENTS This package is designed as an improved and compatible replacement for Net::DNS::ZoneFile 1.04 which was created by Luis Munoz in 2002 as a separate CPAN module. The present implementation is the result of an agreement to merge our two different approaches into one package integrated into Net::DNS. The contribution of Luis Munoz is gratefully acknowledged. Thanks are also due to Willem Toorop for his constructive criticism of the initial version and invaluable assistance during testing. =head1 COPYRIGHT Copyright (c)2011-2012 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035 Section 5.1, RFC2308, BIND 9 Administrator Reference Manual =cut Net-DNS-1.07/lib/Net/DNS/Resolver/0000755000175000017500000000000013031240175015672 5ustar willemwillemNet-DNS-1.07/lib/Net/DNS/Resolver/os2.pm0000644000175000017500000000437513031240164016742 0ustar willemwillempackage Net::DNS::Resolver::os2; # # $Id: os2.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; =head1 NAME Net::DNS::Resolver::os2 - OS2 resolver class =cut use strict; use base qw(Net::DNS::Resolver::Base); my $config_dir = $ENV{ETC} || '/etc'; my $resolv_conf = "$config_dir/resolv"; my $dotfile = '.resolv.conf'; my @resolv_conf = grep -f $_ && -r _, $resolv_conf; my @config_path; push( @config_path, $ENV{HOME} ) if exists $ENV{HOME}; push( @config_path, '.' ); my @config_file = grep -f $_ && -o _, map "$_/$dotfile", @config_path; sub _untaint { map { m/^(.*)$/; $1 } grep defined, @_; } sub _init { my $defaults = shift->_defaults; foreach (@resolv_conf) { $defaults->_read_config_file($_); } foreach my $attr (qw(nameservers searchlist)) { $defaults->$attr( _untaint $defaults->$attr() ); } foreach (@config_file) { $defaults->_read_config_file($_); } $defaults->_read_env; } 1; __END__ =head1 SYNOPSIS use Net::DNS::Resolver; =head1 DESCRIPTION This class implements the OS specific portions of C. No user serviceable parts inside, see L for all your resolving needs. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L =cut Net-DNS-1.07/lib/Net/DNS/Resolver/Base.pm0000644000175000017500000007077213031240164017115 0ustar willemwillempackage Net::DNS::Resolver::Base; # # $Id: Base.pm 1512 2016-10-26 09:14:27Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1512 $)[1]; # Allow taint tests to be optimised away when appropriate. use constant UTIL => defined eval 'require Scalar::Util'; use constant UNCND => $] < 5.008; ## eval '${^TAINT}' breaks old compilers use constant TAINT => UTIL && ( UNCND || eval '${^TAINT}' ); use strict; use integer; use Carp; use IO::Select; use IO::Socket; use Net::DNS::RR; use Net::DNS::Packet; use constant INT16SZ => 2; use constant PACKETSZ => 512; # # Implementation notes wrt IPv6 support when using perl before 5.20.0. # # In general we try to be gracious to those stacks that do not have IPv6 support. # We test that by means of the availability of IO::Socket::INET6 or IO::Socket::IP # # We have chosen not to use mapped IPv4 addresses, there seem to be issues # with this; as a result we use separate sockets for each family type. # # inet_pton is not available on WIN32, so we only use the getaddrinfo # call to translate IP addresses to socketaddress. # # The configuration options force_v4, force_v6, prefer_v4 and prefer_v6 # are provided to control IPv6 behaviour for test purposes. # # Olaf Kolkman, RIPE NCC, December 2003. # [Revised March 2016] use constant USE_SOCKET_IP => defined eval 'use Socket 1.98; use IO::Socket::IP 0.32; 1;'; use constant USE_SOCKET_INET => defined eval 'require IO::Socket::INET'; use constant USE_SOCKET_INET6 => defined eval 'require IO::Socket::INET6'; use constant IPv4 => USE_SOCKET_IP || USE_SOCKET_INET; use constant IPv6 => USE_SOCKET_IP || USE_SOCKET_INET6; # If SOCKSified Perl, use TCP instead of UDP and keep the socket open. use constant SOCKS => scalar eval 'require Config; $Config::Config{usesocks}'; # # Set up a closure to be our class data. # { my $defaults = bless { nameserver4 => ['127.0.0.1'], nameserver6 => ['::1'], port => 53, srcaddr4 => '0.0.0.0', srcaddr6 => '::', srcport => 0, searchlist => [], retrans => 5, retry => 4, usevc => ( SOCKS ? 1 : 0 ), igntc => 0, recurse => 1, defnames => 1, dnsrch => 1, debug => 0, tcp_timeout => 120, udp_timeout => 30, persistent_tcp => ( SOCKS ? 1 : 0 ), persistent_udp => 0, dnssec => 0, adflag => 0, # see RFC6840, 5.7 cdflag => 0, # see RFC6840, 5.9 udppacketsize => 0, # value bounded below by PACKETSZ force_v4 => ( IPv6 ? 0 : 1 ), force_v6 => 0, # only relevant if IPv6 is supported prefer_v4 => ( IPv6 ? 1 : 0 ), }, __PACKAGE__; sub _defaults { return $defaults; } } # These are the attributes that the user may specify in the new() constructor. my %public_attr = ( map( {$_ => $_} keys %{&_defaults}, qw(domain nameserver nameservers prefer_v6 srcaddr) ), map( {$_ => 0} qw(nameserver4 nameserver6 srcaddr4 srcaddr6) ), ); my $initial; sub new { my ( $class, %args ) = @_; my $self; my $base = $class->_defaults; my $init = $initial; $initial ||= bless {%$base}, $class; if ( my $file = $args{config_file} ) { $self = bless {%$initial}, $class; $self->_read_config_file($file); # user specified config $self->nameserver( map { m/^(.*)$/; $1 } $self->nameserver ); $self->searchlist( map { m/^(.*)$/; $1 } $self->searchlist ); %$base = %$self unless $init; # define default configuration } elsif ($init) { $self = bless {%$base}, $class; } else { $class->_init(); # define default configuration $self = bless {%$base}, $class; } while ( my ( $attr, $value ) = each %args ) { next unless $public_attr{$attr}; my $ref = ref($value); croak "usage: $class->new( $attr => [...] )" if $ref && ( $ref ne 'ARRAY' ); $self->$attr( $ref ? @$value : $value ); } return $self; } my %resolv_conf = ( ## map traditional resolv.conf option names attempts => 'retry', inet6 => 'prefer_v6', timeout => 'retrans', ); my %env_option = ( ## any resolver attribute except as listed below %public_attr, %resolv_conf, map { $_ => 0 } qw(nameserver nameservers domain searchlist), ); sub _read_env { ## read resolver config environment variables my $self = shift; $self->nameservers( map split, $ENV{RES_NAMESERVERS} ) if exists $ENV{RES_NAMESERVERS}; $self->domain( $ENV{LOCALDOMAIN} ) if exists $ENV{LOCALDOMAIN}; $self->searchlist( map split, $ENV{RES_SEARCHLIST} ) if exists $ENV{RES_SEARCHLIST}; if ( exists $ENV{RES_OPTIONS} ) { foreach ( map split, $ENV{RES_OPTIONS} ) { my ( $name, $val ) = split( m/:/, $_, 2 ); my $attribute = $env_option{$name} || next; $val = 1 unless defined $val; $self->$attribute($val); } } } sub _read_config_file { ## read resolver config file my $self = shift; my $file = shift; my @ns; local *FILE; open( FILE, $file ) or croak "Could not open $file: $!"; local $_; while () { s/[;#].*$//; # strip comments /^nameserver/ && do { my ( $keyword, @ip ) = grep defined, split; push @ns, @ip; next; }; /^option/ && do { my ( $keyword, @option ) = grep defined, split; foreach (@option) { my ( $name, $val ) = split( m/:/, $_, 2 ); my $attribute = $resolv_conf{$name} || next; $val = 1 unless defined $val; $self->$attribute($val); } next; }; /^domain/ && do { my ( $keyword, $domain ) = grep defined, split; $self->domain($domain); next; }; /^search/ && do { my ( $keyword, @searchlist ) = grep defined, split; $self->searchlist(@searchlist); next; }; } close(FILE); $self->nameservers(@ns); } sub string { my $self = shift; $self = $self->_defaults unless ref($self); my @nslist = $self->nameservers(); my $domain = $self->domain; return <{searchlist}} ;; nameservers = @nslist ;; defnames = $self->{defnames} dnsrch = $self->{dnsrch} ;; retrans = $self->{retrans} retry = $self->{retry} ;; recurse = $self->{recurse} igntc = $self->{igntc} ;; usevc = $self->{usevc} port = $self->{port} ;; tcp_timeout = $self->{tcp_timeout} persistent_tcp = $self->{persistent_tcp} ;; udp_timeout = $self->{udp_timeout} persistent_udp = $self->{persistent_udp} ;; prefer_v4 = $self->{prefer_v4} force_v4 = $self->{force_v4} ;; debug = $self->{debug} force_v6 = $self->{force_v6} END } sub print { print &string; } sub domain { my $self = shift; my ($head) = $self->searchlist(@_); my @list = grep defined, $head; wantarray ? @list : "@list"; } sub searchlist { my $self = shift; $self = $self->_defaults unless ref($self); return $self->{searchlist} = [@_] unless defined wantarray; $self->{searchlist} = [@_] if scalar @_; my @searchlist = @{$self->{searchlist}}; } sub nameservers { my $self = shift; $self = $self->_defaults unless ref($self); my ( @ipv4, @ipv6 ); foreach my $ns ( grep defined, @_ ) { do { push @ipv6, $ns; next } if _ipv6($ns); do { push @ipv4, $ns; next } if _ipv4($ns); my $defres = ref($self)->new( debug => $self->{debug} ); $defres->{persistent} = $self->{persistent}; my $names = {}; my $packet = $defres->search( $ns, 'A' ); my @iplist = _cname_addr( $packet, $names ); if (IPv6) { $packet = $defres->search( $ns, 'AAAA' ); push @iplist, _cname_addr( $packet, $names ); } $self->errorstring( $defres->errorstring ); my %address = map { ( $_ => $_ ) } @iplist; # tainted my @unique = values %address; carp "unresolvable name: $ns" unless @unique; push @ipv4, grep _ipv4($_), @unique; push @ipv6, grep _ipv6($_), @unique; } unless ( defined wantarray ) { $self->{nameserver4} = \@ipv4; $self->{nameserver6} = \@ipv6; return; } if ( scalar @_ ) { $self->{nameserver4} = \@ipv4; $self->{nameserver6} = \@ipv6; } my @ns4 = $self->force_v6 ? () : @{$self->{nameserver4}}; my @ns6 = $self->force_v4 ? () : @{$self->{nameserver6}}; my @returnval = $self->{prefer_v4} ? ( @ns4, @ns6 ) : ( @ns6, @ns4 ); return @returnval if scalar @returnval; my $error = 'no nameservers'; $error = 'IPv4 transport disabled' if scalar(@ns4) < scalar @{$self->{nameserver4}}; $error = 'IPv6 transport disabled' if scalar(@ns6) < scalar @{$self->{nameserver6}}; $self->errorstring($error); return @returnval; } sub nameserver { &nameservers; } # uncoverable pod sub _cname_addr { # TODO 20081217 # This code does not follow CNAME chains, it only looks inside the packet. # Out of bailiwick will fail. my @null; my $packet = shift || return @null; my $names = shift; map $names->{lc( $_->qname )}++, $packet->question; map $names->{lc( $_->cname )}++, grep $_->can('cname'), $packet->answer; my @addr = grep $_->can('address'), $packet->answer; map $_->address, grep $names->{lc( $_->name )}, @addr; } sub answerfrom { my $self = shift; $self->{answerfrom} = shift if scalar @_; return $self->{answerfrom}; } sub _reset_errorstring { shift->{errorstring} = ''; } sub errorstring { my $self = shift; $self->{errorstring} = shift if scalar @_; return $self->{errorstring}; } sub query { my $self = shift; my $name = shift || '.'; # resolve name containing no dots or colons by appending domain my @sfix = $self->{defnames} && $name !~ m/[:.]/ ? $self->domain : (); my $fqdn = join '.', $name, @sfix; $self->_diag( 'query(', $fqdn, @_, ')' ); my $packet = $self->send( $fqdn, @_ ) || return; return $packet->header->ancount ? $packet : undef; } sub search { my $self = shift; return $self->query(@_) unless $self->{dnsrch}; my $name = shift || '.'; my @sfix = $self->searchlist; my @list = $name =~ m/[.]/ ? ( undef, @sfix ) : ( @sfix, undef ); foreach my $suffix ( $name =~ m/:|\.\d*$/ ? undef : @list ) { my $fqname = $suffix ? join( '.', $name, $suffix ) : $name; $self->_diag( 'search(', $fqname, @_, ')' ); my $packet = $self->send( $fqname, @_ ) || next; return $packet->header->ancount ? $packet : next; } return undef; } sub send { my $self = shift; my $packet = $self->_make_query_packet(@_); my $packet_data = $packet->data; return $self->_send_tcp( $packet, $packet_data ) if $self->{usevc} || length $packet_data > $self->_packetsz; my $ans = $self->_send_udp( $packet, $packet_data ) || return; return $ans if $self->{igntc}; return $ans unless $ans->header->tc; $self->_diag('packet truncated: retrying using TCP'); $self->_send_tcp( $packet, $packet_data ); } sub _send_tcp { my ( $self, $packet, $packet_data ) = @_; $self->_reset_errorstring; my $tcp_packet = pack 'n a*', length($packet_data), $packet_data; my @ns = $self->nameservers(); my $lastanswer; foreach my $ip (@ns) { my $socket = $self->_create_tcp_socket($ip) || next; my $select = IO::Select->new($socket); $self->_diag( 'tcp send', "[$ip]" ); $socket->send($tcp_packet); $self->errorstring($!); next unless $select->can_read( $self->{tcp_timeout} ); my $buffer = _read_tcp($socket); $self->answerfrom($ip); $self->_diag( 'answer from', "[$ip]", length($buffer), 'bytes' ); my $ans = Net::DNS::Packet->new( \$buffer, $self->{debug} ); $self->errorstring($@); next unless $ans; $ans->answerfrom($ip); $lastanswer = $ans; my $rcode = $ans->header->rcode; last if $rcode eq 'NOERROR'; last if $rcode eq 'NXDOMAIN'; $self->errorstring($rcode); } return unless $lastanswer; if ( $self->{tsig_rr} && !$lastanswer->verify($packet) ) { $self->_diag( $self->errorstring( $lastanswer->verifyerr ) ); return; } $self->errorstring( $lastanswer->header->rcode ); # historical quirk return $lastanswer; } sub _send_udp { my ( $self, $packet, $packet_data ) = @_; $self->_reset_errorstring; my @ns = $self->nameservers; my $port = $self->{port}; my $queryid = $packet->header->id; my $retrans = $self->{retrans} || 1; my $retry = $self->{retry} || 1; my $select = IO::Select->new(); my $servers = scalar(@ns); my $timeout = $servers ? do { no integer; $retrans / $servers } : 0; my $lastanswer; # Perform each round of retries. RETRY: for ( 1 .. $retry ) { # assumed to be a small number # Try each nameserver. NAMESERVER: foreach my $ns (@ns) { # Construct an array of 3 element arrays unless ( ref $ns ) { my $socket = $self->_create_udp_socket($ns) || next; my $dst_sockaddr = $self->_create_dst_sockaddr( $ns, $port ); $ns = [$socket, $ns, $dst_sockaddr]; } my ( $socket, $ip, $dst_sockaddr, $failed ) = @$ns; next if $failed; $self->_diag( 'udp send', "[$ip]:$port" ); $socket->send( $packet_data, 0, $dst_sockaddr ); $self->errorstring( $$ns[3] = $! ); # handle failure to detect taint inside socket->send() die 'Insecure dependency while running with -T switch' if TAINT && Scalar::Util::tainted($dst_sockaddr); $select->add($socket); while ( my ($socket) = $select->can_read($timeout) ) { $select->remove($socket); my $peer = $socket->peerhost; $self->answerfrom($peer); my $buffer = _read_udp( $socket, $self->_packetsz ); $self->_diag( "answer from [$peer]", length($buffer), 'bytes' ); my $ans = Net::DNS::Packet->new( \$buffer, $self->{debug} ); $self->errorstring($@); next unless $ans; my $header = $ans->header; next unless $header->qr; next unless $header->id == $queryid; $ans->answerfrom($peer); $lastanswer = $ans; my $rcode = $header->rcode; last if $rcode eq 'NOERROR'; last if $rcode eq 'NXDOMAIN'; $self->errorstring( $$ns[3] = $rcode ); } #SELECTOR LOOP next unless $lastanswer; if ( $self->{tsig_rr} && !$lastanswer->verify($packet) ) { my $error = $$ns[3] = $lastanswer->verifyerr; $self->_diag( $self->errorstring($error) ); next; } $self->errorstring( $lastanswer->header->rcode ); # historical quirk return $lastanswer; } #NAMESERVER LOOP no integer; $timeout += $timeout; } #RETRY LOOP $self->_diag( $self->errorstring('query timed out') ) unless $lastanswer; return; } sub bgsend { my $self = shift; my $packet = $self->_make_query_packet(@_); my $packet_data = $packet->data; return $self->_bgsend_tcp( $packet, $packet_data ) if $self->{usevc} || length $packet_data > $self->_packetsz; return $self->_bgsend_udp( $packet, $packet_data ); } sub _bgsend_tcp { my ( $self, $packet, $packet_data ) = @_; $self->_reset_errorstring; my $tcp_packet = pack 'n a*', length($packet_data), $packet_data; foreach my $ip ( $self->nameservers ) { my $socket = $self->_create_tcp_socket($ip) || next; $self->_diag( 'bgsend', "[$ip]" ); $socket->send($tcp_packet); $self->errorstring($!); my $expire = time() + $self->{tcp_timeout}; ${*$socket}{net_dns_bg} = [$expire, $packet]; return $socket; } $self->_diag( $self->errorstring ); return undef; } sub _bgsend_udp { my ( $self, $packet, $packet_data ) = @_; $self->_reset_errorstring; my $port = $self->{port}; foreach my $ip ( $self->nameservers ) { my $socket = $self->_create_udp_socket($ip) || next; my $dst_sockaddr = $self->_create_dst_sockaddr( $ip, $port ); $self->_diag( 'bgsend', "[$ip]:$port" ); $socket->send( $packet_data, 0, $dst_sockaddr ); $self->errorstring($!); # handle failure to detect taint inside $socket->send() die 'Insecure dependency while running with -T switch' if TAINT && Scalar::Util::tainted($dst_sockaddr); my $expire = time() + $self->{udp_timeout}; ${*$socket}{net_dns_bg} = [$expire, $packet]; return $socket; } $self->_diag( $self->errorstring ); return undef; } sub bgbusy { my ( $self, $handle ) = @_; return unless $handle; my $appendix = ${*$handle}{net_dns_bg} ||= [time() + $self->{udp_timeout}]; my ( $expire, $query, $read ) = @$appendix; return if ref($read); unless ( IO::Select->new($handle)->can_read(0.2) ) { return time() <= $expire; } return if $self->{igntc}; return unless $query; return unless $handle->socktype() == SOCK_DGRAM; my $ans = $self->_bgread($handle); $$appendix[2] = [$ans]; return unless $ans; return unless $ans->header->tc; $self->_diag('packet truncated: retrying using TCP'); my $tcp = $self->_bgsend_tcp( $query, $query->data ); return defined( $_[1] = $tcp ) if $tcp; } sub bgisready { ## historical !&bgbusy; # uncoverable pod } sub bgread { while (&bgbusy) { next; } # side effect: TCP retry &_bgread; } sub _bgread { my ( $self, $handle ) = @_; return unless $handle; my $appendix = ${*$handle}{net_dns_bg}; my ( $expire, $query, $read ) = @$appendix; return shift(@$read) if ref($read); return unless IO::Select->new($handle)->can_read(0); my $peer = $handle->peerhost; $self->answerfrom($peer); my $dgram = $handle->socktype() == SOCK_DGRAM; my $buffer = $dgram ? _read_udp( $handle, $self->_packetsz ) : _read_tcp($handle); $self->_diag( "answer from [$peer]", length($buffer), 'bytes' ); my $ans = Net::DNS::Packet->new( \$buffer, $self->{debug} ); $self->errorstring($@); return unless $ans; if ( $self->{tsig_rr} && !$ans->verify($query) ) { $self->errorstring( $ans->verifyerr ); return; } my $header = $ans->header; return unless $header->qr; $ans->answerfrom($peer); return ( ref($query) && ( $header->id != $query->header->id ) ) ? undef : $ans; } sub axfr { ## zone transfer eval { my $self = shift; my ( $select, $verify, @rr, $soa ) = $self->_axfr_start(@_); my $iterator = sub { ## iterate over RRs my $rr = shift(@rr); if ( ref($rr) eq 'Net::DNS::RR::SOA' ) { return $soa = $rr unless $soa; $select = undef; return if $rr->encode eq $soa->encode; croak $self->errorstring('mismatched final SOA'); } return $rr if scalar @rr; my $reply; ( $reply, $verify ) = $self->_axfr_next( $select, $verify ); @rr = $reply->answer; return $rr; }; return $iterator unless wantarray; my @zone; # assemble whole zone while ( my $rr = $iterator->() ) { push @zone, $rr, @rr; # copy RRs en bloc @rr = pop(@zone); # leave last one in @rr } return @zone; }; } sub axfr_start { ## historical my $self = shift; # uncoverable pod defined( $self->{axfr_iter} = $self->axfr(@_) ); } sub axfr_next { ## historical shift->{axfr_iter}->(); # uncoverable pod } sub _axfr_start { my $self = shift; my $dname = scalar(@_) ? shift : $self->domain; my @class = @_; my $request = $self->_make_query_packet( $dname, 'AXFR', @class ); my $content = $request->data; my $TCP_msg = pack 'n a*', length($content), $content; $self->_diag("axfr_start( $dname @class )"); my ( $select, $reply, $rcode ); foreach my $ns ( $self->nameservers ) { my $socket = $self->_create_tcp_socket($ns) || next; $self->_diag("axfr_start nameserver [$ns]"); $select = IO::Select->new($socket); $socket->send($TCP_msg); $self->errorstring($!); ($reply) = $self->_axfr_next($select); last if ( $rcode = $reply->header->rcode ) eq 'NOERROR'; } croak $self->errorstring unless $reply; $self->errorstring($rcode); # historical quirk my $verify = $request->sigrr ? $request : undef; unless ($verify) { croak $self->errorstring unless $rcode eq 'NOERROR'; return ( $select, $verify, $reply->answer ); } my $verifyok = $reply->verify($verify); croak $self->errorstring( $reply->verifyerr ) unless $verifyok; croak $self->errorstring unless $rcode eq 'NOERROR'; return ( $select, $verifyok, $reply->answer ); } sub _axfr_next { my $self = shift; my $select = shift || return; my $verify = shift; my ($socket) = $select->can_read( $self->{tcp_timeout} ); croak $self->errorstring('timed out') unless $socket; $self->answerfrom( $socket->peerhost ); my $buffer = _read_tcp($socket); $self->_diag( 'received', length($buffer), 'bytes' ); my $packet = Net::DNS::Packet->new( \$buffer ); croak $@, $self->errorstring('corrupt packet') if $@; return ( $packet, $verify ) unless $verify; my $verifyok = $packet->verify($verify); croak $self->errorstring( $packet->verifyerr ) unless $verifyok; return ( $packet, $verifyok ); } # # Usage: $data = _read_tcp($socket); # sub _read_tcp { my $socket = shift; my $size_buf = ''; $socket->recv( $size_buf, INT16SZ ); my ($unread) = unpack 'n*', $size_buf; my $buffer = ''; while ($unread) { # During some of my tests recv() returned undef even # though there was no error. Checking for the amount # of data read appears to work around that problem. my $read_buf = ''; $socket->recv( $read_buf, $unread ); my $read = length $read_buf; last unless $read; # uncoverable branch $buffer .= $read_buf; $unread -= $read; } return $buffer; } # # Usage: $data = _read_udp($socket, $length); # sub _read_udp { my $socket = shift; my $buffer = ''; $socket->recv( $buffer, shift ); return $buffer; } sub _create_tcp_socket { my $self = shift; my $ip = shift; my $sock_key = "TCP[$ip]"; my $socket; if ( $socket = $self->{persistent}{$sock_key} ) { $self->_diag( 'using persistent socket', $sock_key ); return $socket if $socket->connected; $self->_diag('socket disconnected (trying to connect)'); } my $dstport = $self->{port}; my $srcport = $self->{srcport}; my $timeout = $self->{tcp_timeout} || 1; if (USE_SOCKET_IP) { my $srcaddr = _ipv6($ip) ? $self->{srcaddr6} : $self->{srcaddr4}; $socket = IO::Socket::IP->new( LocalAddr => $srcaddr, LocalPort => $srcport, PeerAddr => $ip, PeerPort => $dstport, Proto => 'tcp', Timeout => $timeout ) } elsif ( not _ipv6($ip) ) { $socket = IO::Socket::INET->new( LocalAddr => $self->{srcaddr4}, LocalPort => ( $srcport || undef ), PeerAddr => $ip, PeerPort => $dstport, Proto => 'tcp', Timeout => $timeout ) } elsif (USE_SOCKET_INET6) { $socket = IO::Socket::INET6->new( LocalAddr => $self->{srcaddr6}, LocalPort => ( $srcport || undef ), PeerAddr => $ip, PeerPort => $dstport, Proto => 'tcp', Timeout => $timeout ); } $self->{persistent}{$sock_key} = $self->{persistent_tcp} ? $socket : undef; $self->errorstring("no socket $sock_key $!") unless $socket; return $socket; } sub _create_udp_socket { my $self = shift; my $ip = shift; my $ip6_addr = IPv6 && _ipv6($ip); my $sock_key = IPv6 && $ip6_addr ? 'UDP/IPv6' : 'UDP/IPv4'; my $socket; return $socket if $socket = $self->{persistent}{$sock_key}; my $srcport = $self->{srcport}; if (USE_SOCKET_IP) { my $srcaddr = $ip6_addr ? $self->{srcaddr6} : $self->{srcaddr4}; $socket = IO::Socket::IP->new( LocalAddr => $srcaddr, LocalPort => $srcport, Proto => 'udp', Type => SOCK_DGRAM ) } elsif ( not $ip6_addr ) { $socket = IO::Socket::INET->new( LocalAddr => $self->{srcaddr4}, LocalPort => ( $srcport || undef ), Proto => 'udp', Type => SOCK_DGRAM ) } elsif (USE_SOCKET_INET6) { $socket = IO::Socket::INET6->new( LocalAddr => $self->{srcaddr6}, LocalPort => ( $srcport || undef ), Proto => 'udp', Type => SOCK_DGRAM ); } $self->{persistent}{$sock_key} = $self->{persistent_udp} ? $socket : undef; $self->errorstring("no socket $sock_key $!") unless $socket; return $socket; } sub _create_dst_sockaddr { ## create UDP destination sockaddr structure my ( $self, $ip, $port ) = @_; no strict; if (USE_SOCKET_IP) { my $family = _ipv6($ip) ? AF_INET6 : AF_INET; my ( $error, $result ) = Socket::getaddrinfo( $ip, $port, { family => $family, flags => Socket::AI_NUMERICHOST, protocol => Socket::IPPROTO_UDP, socktype => SOCK_DGRAM } ); return $result->{addr}; # NB: error flagged by socket->send } elsif (USE_SOCKET_INET6) { return sockaddr_in( $port, inet_aton($ip) ) unless _ipv6($ip); local $^W = 0; # circumvent perl -w warnings my @res = Socket6::getaddrinfo( $ip, $port, AF_INET6, SOCK_DGRAM, 0, AI_NUMERICHOST ); return $res[3]; # NB: error flagged by socket->send } else { return sockaddr_in( $port, inet_aton($ip) ) unless _ipv6($ip); } } # Lightweight versions of subroutines from Net::IP module, recoded to fix RT#96812 sub _ipv4 { for (shift) { return /^[0-9.]+\.[0-9]+$/; # dotted digits } } sub _ipv6 { for (shift) { return 1 if /^[:0-9a-f]+:[0-9a-f]*$/i; # mixed : and hexdigits return 1 if /^[:0-9a-f]+:[0-9.]+$/i; # prefix + dotted digits return /^[:0-9a-f]+:[0-9a-f]*[%].+$/i; # RFC4007 scoped address } } sub _make_query_packet { my $self = shift; my ($packet) = @_; if ( ref($packet) ) { my $header = $packet->header; $header->rd( $self->{recurse} ) if $header->opcode eq 'QUERY'; } else { $packet = Net::DNS::Packet->new(@_); my $header = $packet->header; $header->ad( $self->{adflag} ); # RFC6840, 5.7 $header->cd( $self->{cdflag} ); # RFC6840, 5.9 $header->do(1) if $self->dnssec; $header->rd( $self->{recurse} ); } $packet->edns->size( $self->{udppacketsize} ); # advertise UDPsize for local stack if ( $self->{tsig_rr} ) { $packet->sign_tsig( $self->{tsig_rr} ) unless $packet->sigrr; } return $packet; } sub dnssec { my $self = shift; return $self->{dnssec} unless scalar @_; # increase default udppacket size if flag set $self->udppacketsize(2048) if $self->{dnssec} = shift; return $self->{dnssec}; } sub force_v6 { my $self = shift; return $self->{force_v6} unless scalar @_; my $value = shift; $self->force_v4(0) if $value; $self->{force_v6} = $value ? 1 : 0; } sub force_v4 { my $self = shift; return $self->{force_v4} unless scalar @_; my $value = shift; $self->force_v6(0) if $value; $self->{force_v4} = $value ? 1 : 0; } sub prefer_v6 { my $self = shift; $self->{prefer_v4} = shift() ? 0 : 1 if scalar @_; $self->{prefer_v4} ? 0 : 1; } sub prefer_v4 { my $self = shift; return $self->{prefer_v4} unless scalar @_; $self->{prefer_v4} = shift() ? 1 : 0; } sub srcaddr { my $self = shift; for (@_) { my $hashkey = _ipv6($_) ? 'srcaddr6' : 'srcaddr4'; $self->{$hashkey} = $_; } return shift; } sub tsig { my $self = shift; $self->{tsig_rr} = eval { local $SIG{__DIE__}; require Net::DNS::RR::TSIG; Net::DNS::RR::TSIG->create(@_); }; croak "${@}unable to create TSIG record" if $@; } # if ($self->{udppacketsize} > PACKETSZ # then we use EDNS and $self->{udppacketsize} # should be taken as the maximum packet_data length sub _packetsz { my $udpsize = shift->{udppacketsize} || 0; return $udpsize > PACKETSZ ? $udpsize : PACKETSZ; } sub udppacketsize { my $self = shift; $self->{udppacketsize} = shift if scalar @_; return $self->_packetsz; } # # Keep this method around. Folk depend on it although it is neither documented nor exported. # my $warned; sub make_query_packet { ## historical unless ( $warned++ ) { # uncoverable pod local $SIG{__WARN__}; carp 'deprecated method; see RT#37104'; } &_make_query_packet; } sub _diag { ## debug output my $self = shift; print "\n;; @_\n" if $self->{debug}; } use vars qw($AUTOLOAD); sub DESTROY { } ## Avoid tickling AUTOLOAD (in cleanup) sub AUTOLOAD { ## Default method my ($self) = @_; my $name = $AUTOLOAD; $name =~ s/.*://; croak "$name: no such method" unless $public_attr{$name}; no strict q/refs/; *{$AUTOLOAD} = sub { my $self = shift; $self = $self->_defaults unless ref($self); $self->{$name} = shift if scalar @_; return $self->{$name}; }; goto &{$AUTOLOAD}; } 1; __END__ =head1 NAME Net::DNS::Resolver::Base - DNS resolver base class =head1 SYNOPSIS use base qw(Net::DNS::Resolver::Base); =head1 DESCRIPTION This class is the common base class for the different platform sub-classes of L. No user serviceable parts inside, see L for all your resolving needs. =head1 METHODS =head2 new, domain, searchlist, nameservers, print, string, errorstring, =head2 search, query, send, bgsend, bgbusy, bgread, axfr, answerfrom, =head2 force_v4, force_v6, prefer_v4, prefer_v6, =head2 dnssec, srcaddr, tsig, udppacketsize See L. =head1 COPYRIGHT Copyright (c)2003,2004 Chris Reinhardt. Portions Copyright (c)2005 Olaf Kolkman. Portions Copyright (c)2014,2015 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L =cut Net-DNS-1.07/lib/Net/DNS/Resolver/android.pm0000644000175000017500000000470213031240164017651 0ustar willemwillempackage Net::DNS::Resolver::android; # # $Id: android.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; =head1 NAME Net::DNS::Resolver::android - Android resolver class =cut use strict; use base qw(Net::DNS::Resolver::Base); my $config_dir = $ENV{ANDROID_ROOT} || '/system'; my $resolv_conf = "$config_dir/etc/resolv.conf"; my $dotfile = '.resolv.conf'; my @resolv_conf = grep -f $_ && -r _, $resolv_conf; my @config_path; push( @config_path, $ENV{HOME} ) if exists $ENV{HOME}; push( @config_path, '.' ); my @config_file = grep -f $_ && -o _, map "$_/$dotfile", @config_path; sub _untaint { map { m/^(.*)$/; $1 } grep defined, @_; } sub _init { my $defaults = shift->_defaults; foreach (@resolv_conf) { $defaults->_read_config_file($_); } my @nameservers = $defaults->nameservers; for ( 1 .. 4 ) { my $ret = `getprop net.dns$_` || next; chomp $ret; push @nameservers, $ret || next; } $defaults->nameservers( _untaint @nameservers ); $defaults->searchlist( _untaint $defaults->searchlist ); foreach (@config_file) { $defaults->_read_config_file($_); } $defaults->_read_env; } 1; __END__ =head1 SYNOPSIS use Net::DNS::Resolver; =head1 DESCRIPTION This class implements the OS specific portions of C. No user serviceable parts inside, see L for all your resolving needs. =head1 COPYRIGHT Copyright (c)2014 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L =cut Net-DNS-1.07/lib/Net/DNS/Resolver/UNIX.pm0000644000175000017500000000430513031240164017013 0ustar willemwillempackage Net::DNS::Resolver::UNIX; # # $Id: UNIX.pm 1408 2015-10-06 20:35:56Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1408 $)[1]; =head1 NAME Net::DNS::Resolver::UNIX - Unix resolver class =cut use strict; use base qw(Net::DNS::Resolver::Base); my $resolv_conf = "/etc/resolv.conf"; my $dotfile = '.resolv.conf'; my @resolv_conf = grep -f $_ && -r _, $resolv_conf; my @config_path; push( @config_path, $ENV{HOME} ) if exists $ENV{HOME}; push( @config_path, '.' ); my @config_file = grep -f $_ && -o _, map "$_/$dotfile", @config_path; sub _untaint { map { m/^(.*)$/; $1 } grep defined, @_; } sub _init { my $defaults = shift->_defaults; map $defaults->_read_config_file($_), @resolv_conf; foreach my $attr (qw(nameservers searchlist)) { $defaults->$attr( _untaint $defaults->$attr() ); } map $defaults->_read_config_file($_), @config_file; $defaults->_read_env; } 1; __END__ =head1 SYNOPSIS use Net::DNS::Resolver; =head1 DESCRIPTION This class implements the OS specific portions of C. No user serviceable parts inside, see L for all your resolving needs. =head1 COPYRIGHT Copyright (c)2003 Chris Reinhardt. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L =cut Net-DNS-1.07/lib/Net/DNS/Resolver/Recurse.pm0000644000175000017500000002136113031240164017641 0ustar willemwillempackage Net::DNS::Resolver::Recurse; # # $Id: Recurse.pm 1523 2016-12-29 16:53:52Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1523 $)[1]; =head1 NAME Net::DNS::Resolver::Recurse - DNS recursive resolver =head1 SYNOPSIS use Net::DNS::Resolver::Recurse; $resolver = new Net::DNS::Resolver::Recurse(); $packet = $resolver->query ( 'www.example.com', 'A' ); $packet = $resolver->search( 'www.example.com', 'A' ); $packet = $resolver->send ( 'www.example.com', 'A' ); =head1 DESCRIPTION This module is a subclass of Net::DNS::Resolver. =cut use strict; use base qw(Net::DNS::Resolver); =head1 METHODS This module inherits almost all the methods from Net::DNS::Resolver. Additional module-specific methods are described below. =head2 hints This method specifies a list of the IP addresses of nameservers to be used to discover the addresses of the root nameservers. $resolver->hints(@ip); If no hints are passed, the priming query is directed to nameservers drawn from a built-in list of IP addresses. =cut my @hints; my $root = []; sub hints { my $self = shift; return @hints unless scalar @_; $root = []; @hints = @_; } =head2 query, search, send The query(), search() and send() methods produce the same result as their counterparts in Net::DNS::Resolver. $packet = $resolver->send( 'www.example.com.', 'A' ); Server-side recursion is suppressed by clearing the recurse flag in query packets and recursive name resolution is performed explicitly. The query() and search() methods are inherited from Net::DNS::Resolver and invoke send() indirectly. =cut sub send { return &Net::DNS::Resolver::Base::send if ref $_[1]; # send Net::DNS::Packet my $self = shift; my $res = bless {persistent => {'.' => $root}, %$self}, ref($self); my $question = new Net::DNS::Question(@_); my $original = pop(@_); # sneaky extra argument needed $original = $question unless ref($original); # to preserve original request my ( $head, @tail ) = $question->{qname}->label; my $domain = lc join( '.', @tail ) || '.'; my $nslist = $res->{persistent}->{$domain} ||= []; unless ( defined $head ) { my $defres = new Net::DNS::Resolver(); $defres->nameservers( $res->_hints ); # fall back to inbuilt list $defres->recurse(0); $defres->udppacketsize(1024); my @config = $defres->nameserver( $res->hints ); return $defres->send(qw(. NS)); } if ( scalar @$nslist ) { $self->_diag("using cached nameservers for $domain"); } else { $domain = lc $question->qname if $question->qtype ne 'NULL'; my $packet = $res->send( $domain, 'NULL', 'IN', $original ); return unless $packet; my @answer = $packet->answer; # return authoritative answer return $packet if $packet->header->aa && grep $_->name eq $original->qname, @answer; my @auth = grep $_->type eq 'NS', $packet->answer, $packet->authority; my %auth = map { lc $_->nsdname => lc $_->name } @auth; my %glue; my @glue = grep $_->can('address'), $packet->additional; foreach ( grep $auth{lc $_->name}, @glue ) { push @{$glue{lc $_->name}}, $_->address; } my %zone = reverse %auth; foreach my $zone ( keys %zone ) { my @nsname = grep $auth{$_} eq $zone, keys %auth; my @list = map $glue{$_} ? $glue{$_} : $_, @nsname; @{$res->{persistent}->{$zone}} = @list; return $packet if length($zone) > length($domain); $self->_diag("cache nameservers for $zone"); @$nslist = @list; } } my $query = new Net::DNS::Packet(); $query->{question} = [$original]; $res = bless {%$res}, qw(Net::DNS::Resolver) if $nslist eq $root; $res->udppacketsize(1024); $res->recurse(0); splice @$nslist, 0, 0, splice( @$nslist, int( rand scalar @$nslist ) ); # cut deck foreach my $ns (@$nslist) { if ( ref $ns ) { my @ip = map @$_, grep ref($_), @$nslist; $res->nameservers(@ip); # cached IP list } else { $self->_diag("find missing glue for $ns"); my $name = $ns; # suppress deep recursion by $ns = []; # inserting placeholder in cache $ns = [$res->nameservers($name)]; # substitute IP list in situ } my $reply = $res->send($query); next unless $reply; $self->_callback($reply); return $reply; } } sub query_dorecursion { &send; } # uncoverable pod =head2 callback This method specifies a code reference to a subroutine, which is then invoked at each stage of the recursive lookup. For example to emulate dig's C<+trace> function: my $coderef = sub { my $packet = shift; printf ";; Received %d bytes from %s\n\n", $packet->answersize, $packet->answerfrom; }; $resolver->callback($coderef); The callback subroutine is not called for queries for missing glue records. =cut sub callback { my $self = shift; ( $self->{callback} ) = grep ref($_) eq 'CODE', @_; } sub _callback { my $callback = shift->{callback}; $callback->(@_) if $callback; } sub recursion_callback { &callback; } # uncoverable pod ######################################## { require Net::DNS::ZoneFile; my $dug = new Net::DNS::ZoneFile( \*DATA ); my @rr = $dug->read; my @auth = grep $_->type eq 'NS', @rr; my %auth = map { lc $_->nsdname => 1 } @auth; my %glue; my @glue = grep $auth{lc $_->name}, @rr; foreach ( grep $_->can('address'), @glue ) { push @{$glue{lc $_->name}}, $_->address; } my @ip = map @$_, values %glue; sub _hints { @ip; } ## default hints } 1; =head1 ACKNOWLEDGEMENT This package is an improved and compatible reimplementation of the Net::DNS::Resolver::Recurse.pm created by Rob Brown in 2002, whose contribution is gratefully acknowledged. =head1 COPYRIGHT Copyright (c)2014 Dick Franks. Portions Copyright (c)2002 Rob Brown. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L =cut __DATA__ ## DEFAULT HINTS ; <<>> DiG 9.9.4-P2-RedHat-9.9.4-18.P2.fc20 <<>> @b.root-servers.net . -t NS ; (2 servers found) ;; global options: +cmd ;; Got answer: ;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 47020 ;; flags: qr aa rd; QUERY: 1, ANSWER: 13, AUTHORITY: 0, ADDITIONAL: 27 ;; WARNING: recursion requested but not available ;; OPT PSEUDOSECTION: ; EDNS: version: 0, flags:; udp: 4096 ;; QUESTION SECTION: ;. IN NS ;; ANSWER SECTION: . 518400 IN NS c.root-servers.net. . 518400 IN NS k.root-servers.net. . 518400 IN NS l.root-servers.net. . 518400 IN NS j.root-servers.net. . 518400 IN NS b.root-servers.net. . 518400 IN NS g.root-servers.net. . 518400 IN NS h.root-servers.net. . 518400 IN NS d.root-servers.net. . 518400 IN NS a.root-servers.net. . 518400 IN NS f.root-servers.net. . 518400 IN NS i.root-servers.net. . 518400 IN NS m.root-servers.net. . 518400 IN NS e.root-servers.net. ;; ADDITIONAL SECTION: a.root-servers.net. 3600000 IN A 198.41.0.4 b.root-servers.net. 3600000 IN A 192.228.79.201 c.root-servers.net. 3600000 IN A 192.33.4.12 d.root-servers.net. 3600000 IN A 199.7.91.13 e.root-servers.net. 3600000 IN A 192.203.230.10 f.root-servers.net. 3600000 IN A 192.5.5.241 g.root-servers.net. 3600000 IN A 192.112.36.4 h.root-servers.net. 3600000 IN A 198.97.190.53 i.root-servers.net. 3600000 IN A 192.36.148.17 j.root-servers.net. 3600000 IN A 192.58.128.30 k.root-servers.net. 3600000 IN A 193.0.14.129 l.root-servers.net. 3600000 IN A 199.7.83.42 m.root-servers.net. 3600000 IN A 202.12.27.33 a.root-servers.net. 3600000 IN AAAA 2001:503:ba3e::2:30 b.root-servers.net. 3600000 IN AAAA 2001:500:84::b c.root-servers.net. 3600000 IN AAAA 2001:500:2::c d.root-servers.net. 3600000 IN AAAA 2001:500:2d::d e.root-servers.net. 3600000 IN AAAA 2001:500:a8::e f.root-servers.net. 3600000 IN AAAA 2001:500:2f::f g.root-servers.net. 3600000 IN AAAA 2001:500:12::d0d h.root-servers.net. 3600000 IN AAAA 2001:500:1::53 i.root-servers.net. 3600000 IN AAAA 2001:7fe::53 j.root-servers.net. 3600000 IN AAAA 2001:503:c27::2:30 k.root-servers.net. 3600000 IN AAAA 2001:7fd::1 l.root-servers.net. 3600000 IN AAAA 2001:500:9f::42 m.root-servers.net. 3600000 IN AAAA 2001:dc3::35 Net-DNS-1.07/lib/Net/DNS/Resolver/MSWin32.pm0000644000175000017500000000743413031240164017400 0ustar willemwillempackage Net::DNS::Resolver::MSWin32; # # $Id: MSWin32.pm 1486 2016-06-03 10:37:10Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1486 $)[1]; =head1 NAME Net::DNS::Resolver::MSWin32 - MS Windows resolver class =cut use strict; use base qw(Net::DNS::Resolver::Base); use Carp; BEGIN { use vars qw($Registry); use constant WINHLP => defined eval 'require Win32::IPHelper'; Win32::IPHelper->import if WINHLP; use constant WINREG => defined eval 'require Win32::TieRegistry'; Win32::TieRegistry->import(qw(KEY_READ REG_DWORD)) if WINREG; } sub _untaint { map { m/^(.*)$/; $1 } grep defined, @_; } sub _init { my $defaults = shift->_defaults; my $debug = 0; my $FIXED_INFO = {}; if ( my $ret = Win32::IPHelper::GetNetworkParams($FIXED_INFO) ) { Carp::croak "GetNetworkParams() error %u: %s\n", $ret, Win32::FormatMessage($ret); } elsif ($debug) { require Data::Dumper; print Data::Dumper::Dumper $FIXED_INFO; } my @nameservers = map { $_->{IpAddress} } @{$FIXED_INFO->{DnsServersList}}; $defaults->nameservers( _untaint @nameservers ); my $devolution = 0; my $domainname = $FIXED_INFO->{DomainName} || ''; my @searchlist = map length, lc $domainname; if (WINREG) { # The Win32::IPHelper does not return searchlist. # Make best effort attempt to get searchlist from the registry. my @root = qw(HKEY_LOCAL_MACHINE SYSTEM CurrentControlSet Services); my $leaf = join '\\', @root, qw(Tcpip Parameters); my $reg_tcpip = $Registry->Open( $leaf, {Access => KEY_READ} ); unless ( defined $reg_tcpip ) { # Didn't work, Win95/98/Me? $leaf = join '\\', @root, qw(VxD MSTCP); $reg_tcpip = $Registry->Open( $leaf, {Access => KEY_READ} ); } if ( defined $reg_tcpip ) { my $searchlist = $reg_tcpip->GetValue('SearchList') || ''; push @searchlist, split m/[\s,]+/, lc $searchlist; my ( $value, $type ) = $reg_tcpip->GetValue('UseDomainNameDevolution'); $devolution = defined $value && $type == REG_DWORD ? hex $value : 0; } } # fix devolution if configured, and simultaneously # make sure no dups (but keep the order) my @list; my %seen; foreach my $entry (@searchlist) { push( @list, $entry ) unless $seen{$entry}++; next unless $devolution; # as long there are more than two pieces, cut while ( $entry =~ m#\..+\.# ) { $entry =~ s#^[^\.]+\.(.+)$#$1#; push( @list, $entry ) unless $seen{$entry}++; } } $defaults->searchlist( _untaint @list ); $defaults->_read_env; } 1; __END__ =head1 SYNOPSIS use Net::DNS::Resolver; =head1 DESCRIPTION This class implements the OS specific portions of C. No user serviceable parts inside, see L for all your resolving needs. =head1 COPYRIGHT Copyright (c)2003 Chris Reinhardt. Portions Copyright (c)2009 Olaf Kolkman, NLnet Labs All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L =cut Net-DNS-1.07/lib/Net/DNS/Resolver/cygwin.pm0000644000175000017500000001151413031240164017530 0ustar willemwillempackage Net::DNS::Resolver::cygwin; # # $Id: cygwin.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; =head1 NAME Net::DNS::Resolver::cygwin - Cygwin resolver class =cut use strict; use base qw(Net::DNS::Resolver::Base); sub _getregkey { my $key = join '/', @_; local *LM; open( LM, "<$key" ) or return ''; my $value = ; $value =~ s/\0+$// if $value; close(LM); return $value || ''; } sub _untaint { map { m/^(.*)$/; $1 } grep defined, @_; } sub _init { my $defaults = shift->_defaults; local *LM; my $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/Tcpip/Parameters'; unless ( -d $root ) { # Doesn't exist, maybe we are on 95/98/Me? $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/VxD/MSTCP'; -d $root || Carp::croak "can't read registry: $!"; } # Best effort to find a useful domain name for the current host # if domain ends up blank, we're probably (?) not connected anywhere # a DNS server is interesting either... my $domain = _getregkey( $root, 'Domain' ) || _getregkey( $root, 'DhcpDomain' ); # If nothing else, the searchlist should probably contain our own domain # also see below for domain name devolution if so configured # (also remove any duplicates later) my $devolution = _getregkey( $root, 'UseDomainNameDevolution' ); my $searchlist = _getregkey( $root, 'SearchList' ); my @searchlist = _untaint $domain, split m/[\s,]+/, $searchlist; # This is (probably) adequate on NT4 my @nt4nameservers; foreach ( grep length, _getregkey( $root, 'NameServer' ), _getregkey( $root, 'DhcpNameServer' ) ) { push @nt4nameservers, split m/[\s,]+/; last; } # but on W2K/XP the registry layout is more advanced due to dynamically # appearing connections. So we attempt to handle them, too... # opt to silently fail if something isn't ok (maybe we're on NT4) # If this doesn't fail override any NT4 style result we found, as it # may be there but is not valid. # drop any duplicates later my @nameservers; my $dnsadapters = join '/', $root, 'DNSRegisteredAdapters'; if ( opendir( LM, $dnsadapters ) ) { my @adapters = grep !/^\.\.?$/, readdir(LM); closedir(LM); foreach my $adapter (@adapters) { my $ns = _getregkey( $dnsadapters, $adapter, 'DNSServerAddresses' ); until ( length($ns) < 4 ) { push @nameservers, join '.', unpack( 'C4', $ns ); substr( $ns, 0, 4 ) = ''; } } } my $interfaces = join '/', $root, 'Interfaces'; if ( opendir( LM, $interfaces ) ) { my @ifacelist = grep !/^\.\.?$/, readdir(LM); closedir(LM); foreach my $iface (@ifacelist) { my $ip = _getregkey( $interfaces, $iface, 'DhcpIPAddress' ) || _getregkey( $interfaces, $iface, 'IPAddress' ); next unless $ip; next if $ip eq '0.0.0.0'; foreach ( grep length, _getregkey( $interfaces, $iface, 'NameServer' ), _getregkey( $interfaces, $iface, 'DhcpNameServer' ) ) { push @nameservers, split m/[\s,]+/; last; } } } @nameservers = @nt4nameservers unless @nameservers; $defaults->nameservers( _untaint @nameservers ); # fix devolution if configured, and simultaneously # make sure no dups (but keep the order) my @list; my %seen; foreach my $entry (@searchlist) { push @list, $entry unless $seen{$entry}++; next unless $devolution; # as long there are more than two pieces, cut while ( $entry =~ m#\..+\.# ) { $entry =~ s#^[^\.]+\.(.+)$#$1#; push @list, $entry unless $seen{$entry}++; } } $defaults->searchlist(@list); $defaults->_read_env; } 1; __END__ =head1 SYNOPSIS use Net::DNS::Resolver; =head1 DESCRIPTION This class implements the OS specific portions of C. No user serviceable parts inside, see L for all your resolving needs. =head1 COPYRIGHT Copyright (c)2003 Sidney Markowitz. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L =cut Net-DNS-1.07/lib/Net/DNS/DomainName.pm0000644000175000017500000001747013031240164016446 0ustar willemwillempackage Net::DNS::DomainName; # # $Id: DomainName.pm 1456 2016-02-17 13:34:00Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1456 $)[1]; =head1 NAME Net::DNS::DomainName - DNS name representation =head1 SYNOPSIS use Net::DNS::DomainName; $object = new Net::DNS::DomainName('example.com'); $name = $object->name; $data = $object->encode; ( $object, $next ) = decode Net::DNS::DomainName( \$data, $offset ); =head1 DESCRIPTION The Net::DNS::DomainName module implements the concrete representation of DNS domain names used within DNS packets. Net::DNS::DomainName defines methods for encoding and decoding wire format octet strings as defined in RFC1035. All other behaviour, including the new() constructor, is inherited from Net::DNS::Domain. The Net::DNS::DomainName1035 and Net::DNS::DomainName2535 packages implement disjoint domain name subtypes which provide the name compression and canonicalisation specified by RFC1035 and RFC2535. These are necessary to meet the backward compatibility requirements introduced by RFC3597. =cut use strict; use base qw(Net::DNS::Domain); use integer; use Carp; use constant FIXlc => scalar eval 'no integer; $] < 5.010'; =head1 METHODS =head2 new $object = new Net::DNS::DomainName('example.com'); Creates a domain name object which identifies the domain specified by the character string argument. =head2 canonical $data = $object->canonical; Returns the canonical wire-format representation of the domain name as defined in RFC2535(8.1). =cut my $lc = sub { ## work around 5.8.x case-folding bug ( my $s = shift ) =~ tr [\101-\132] [\141-\172]; return $s; }; sub canonical { join '', map pack( 'C a*', length($_), FIXlc ? &$lc($_) : lc($_) ), shift->_wire, ''; } =head2 decode $object = decode Net::DNS::DomainName( \$buffer, $offset, $hash ); ( $object, $next ) = decode Net::DNS::DomainName( \$buffer, $offset, $hash ); Creates a domain name object which represents the DNS domain name identified by the wire-format data at the indicated offset within the data buffer. The argument list consists of a reference to a scalar containing the wire-format data and specified offset. The optional reference to a hash table provides improved efficiency of decoding compressed names by exploiting already cached compression pointers. The returned offset value indicates the start of the next item in the data buffer. =cut sub decode { my $label = []; my $self = bless {label => $label}, shift; my $buffer = shift; # reference to data buffer my $offset = shift || 0; # offset within buffer my $cache = shift || {}; # hashed objectref by offset my $buflen = length $$buffer; my $index = $offset; while ( $index < $buflen ) { my $header = unpack( "\@$index C", $$buffer ); unless ($header) { # terminal empty label return wantarray ? ( $self, ++$index ) : $self; } elsif ( $header < 0x40 ) { # non-terminal label push @$label, substr( $$buffer, ++$index, $header ); $index += $header; } elsif ( $header < 0xC0 ) { # deprecated extended label types croak 'unimplemented label type'; } else { # compression pointer my $link = 0x3FFF & unpack( "\@$index n", $$buffer ); croak 'corrupt compression pointer' unless $link < $offset; # uncoverable condition false $self->{origin} = $cache->{$link} ||= decode Net::DNS::DomainName( $buffer, $link, $cache ); return wantarray ? ( $self, $index + 2 ) : $self; } } croak 'corrupt wire-format data'; } =head2 encode $data = $object->encode; Returns the wire-format representation of the domain name suitable for inclusion in a DNS packet buffer. =cut sub encode { join '', map pack( 'C a*', length($_), $_ ), shift->_wire, ''; } ######################################## sub _wire { ## Generate list of wire-format labels my $self = shift; my $label = $self->{label}; my $origin = $self->{origin} || return (@$label); return ( @$label, $origin->_wire ); } ######################################## package Net::DNS::DomainName1035; use base qw(Net::DNS::DomainName); =head1 Net::DNS::DomainName1035 Net::DNS::DomainName1035 implements a subclass of domain name objects which are to be encoded using the compressed wire format defined in RFC1035. use Net::DNS::DomainName; $object = new Net::DNS::DomainName1035('compressible.example.com'); $data = $object->encode( $offset, $hash ); ( $object, $next ) = decode Net::DNS::DomainName1035( \$data, $offset ); Note that RFC3597 implies that the RR types defined in RFC1035 section 3.3 are the only types eligible for compression. =head2 encode $data = $object->encode( $offset, $hash ); Returns the wire-format representation of the domain name suitable for inclusion in a DNS packet buffer. The optional arguments are the offset within the packet data where the domain name is to be stored and a reference to a hash table used to index compressed names within the packet. If the hash reference is undefined, encode() returns the lowercase uncompressed canonical representation defined in RFC2535(8.1). =cut sub encode { my $self = shift; my $offset = shift || 0; # offset in data buffer my $hash = shift || return $self->canonical; # hashed offset by name my @labels = $self->_wire; my $data = ''; while (@labels) { my $name = join( '.', @labels ); return $data . pack( 'n', 0xC000 | $hash->{$name} ) if defined $hash->{$name}; my $label = shift @labels; my $length = length $label; $data .= pack( 'C a*', $length, $label ); next unless $offset < 0x4000; $hash->{$name} = $offset; $offset += 1 + $length; } $data .= pack 'x'; } ######################################## package Net::DNS::DomainName2535; use base qw(Net::DNS::DomainName); =head1 Net::DNS::DomainName2535 Net::DNS::DomainName2535 implements a subclass of domain name objects which are to be encoded using uncompressed wire format. Note that RFC3597, and latterly RFC4034, specifies that the lower case canonical encoding defined in RFC2535 is to be used for RR types defined prior to RFC3597. use Net::DNS::DomainName; $object = new Net::DNS::DomainName2535('incompressible.example.com'); $data = $object->encode( $offset, $hash ); ( $object, $next ) = decode Net::DNS::DomainName2535( \$data, $offset ); =head2 encode $data = $object->encode( $offset, $hash ); Returns the uncompressed wire-format representation of the domain name suitable for inclusion in a DNS packet buffer. If the hash reference is undefined, encode() returns the lowercase canonical form defined in RFC2535(8.1). =cut sub encode { return shift->canonical unless defined $_[2]; join '', map pack( 'C a*', length($_), $_ ), shift->_wire, ''; } 1; __END__ ######################################## =head1 COPYRIGHT Copyright (c)2009-2011 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035, RFC2535, RFC3597, RFC4034 =cut Net-DNS-1.07/lib/Net/DNS/FAQ.pod0000644000175000017500000000212113031240164015176 0ustar willemwillem=head1 NAME Net::DNS::FAQ - Frequently Asked Net::DNS Questions =head1 SYNOPSIS perldoc Net::DNS::FAQ =head1 DESCRIPTION This document serves to answer the most frequently asked questions on both the Net::DNS Mailing List and those sent to the author. The latest version of this FAQ can be found at L =head1 GENERAL =head2 What is Net::DNS? Net::DNS is a perl implementation of a DNS resolver. =head1 INSTALLATION =head2 Where can I find Test::More? Test::More is part of the Test-Simple package, by Michael G Schwern. You should be able to find the distribution at L =head1 USAGE =head2 Why does $resolver->query() return undef when the answer section is empty? The short answer is, do not use query(). $resolver->send() will always return the answer packet, as long as an answer was received. The longer answer is that query() is modeled after the res_query() function from the libresolv C library, which has similar behavior. =head1 VERSION $Id: FAQ.pod 1365 2015-06-26 08:46:01Z willem $ Net-DNS-1.07/lib/Net/DNS/Text.pm0000644000175000017500000001762113031240164015360 0ustar willemwillempackage Net::DNS::Text; # # $Id: Text.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; =head1 NAME Net::DNS::Text - DNS text representation =head1 SYNOPSIS use Net::DNS::Text; $object = new Net::DNS::Text('example'); $string = $object->string; $object = decode Net::DNS::Text( \$data, $offset ); ( $object, $next ) = decode Net::DNS::Text( \$data, $offset ); $data = $object->encode; $text = $object->value; =head1 DESCRIPTION The C module implements a class of text objects with associated class and instance methods. Each text object instance has a fixed identity throughout its lifetime. =cut use strict; use integer; use Carp; use constant ASCII => ref eval { require Encode; Encode::find_encoding('ascii'); # encoding object }; use constant LIBUTF8 => scalar eval { Encode::decode_utf8( chr(91) ) eq '['; # not UTF-EBCDIC [see UTR#16 3.6] }; use constant UTF8 => ref eval { LIBUTF8 && Encode::find_encoding('utf8'); # encoding object }; =head1 METHODS =head2 new $object = new Net::DNS::Text('example'); Creates a text object which encapsulates a single character string component of a resource record. Arbitrary single-byte characters can be represented by \ followed by exactly three decimal digits. Such characters are devoid of any special meaning. A character preceded by \ represents itself, without any special interpretation. =cut my %unescape; ## precalculated numeric escape table sub new { my $self = bless [], shift; croak 'argument undefined' unless defined $_[0]; local $_ = &_encode_utf8; s/^\042(.*)\042$/$1/s; # strip paired quotes s/\134\134/\134\060\071\062/g; # disguise escaped escape s/\134([\060-\071]{3})/$unescape{$1}/eg; # numeric escape s/\134(.)/$1/g; # character escape while ( length $_ > 255 ) { my $chunk = substr( $_, 0, 255 ); # carve into chunks substr( $chunk, -length($1) ) = '' if $chunk =~ /.([\300-\377][\200-\277]*)$/; push @$self, $chunk; substr( $_, 0, length $chunk ) = ''; } push @$self, $_; return $self; } =head2 decode $object = decode Net::DNS::Text( \$buffer, $offset ); ( $object, $next ) = decode Net::DNS::Text( \$buffer, $offset ); Creates a text object which represents the decoded data at the indicated offset within the data buffer. The argument list consists of a reference to a scalar containing the wire-format data and offset of the text data. The returned offset value indicates the start of the next item in the data buffer. =cut sub decode { my $class = shift; my $buffer = shift; # reference to data buffer my $offset = shift || 0; # offset within buffer my $size = shift; # specify size of unbounded text unless ( defined $size ) { $size = unpack "\@$offset C", $$buffer; $offset++; } my $next = $offset + $size; croak 'corrupt wire-format data' if $next > length $$buffer; my $self = bless [unpack( "\@$offset a$size", $$buffer )], $class; return wantarray ? ( $self, $next ) : $self; } =head2 encode $data = $object->encode; Returns the wire-format encoded representation of the text object suitable for inclusion in a DNS packet buffer. =cut sub encode { my $self = shift; join '', map pack( 'C a*', length $_, $_ ), @$self; } =head2 raw $data = $object->raw; Returns the wire-format encoded representation of the text object without the explicit length field. =cut sub raw { my $self = shift; join '', map pack( 'a*', $_ ), @$self; } =head2 value $value = $text->value; Character string representation of the text object. =cut sub value { return unless defined wantarray; my $self = shift; _decode_utf8( join '', @$self ); } =head2 string $string = $text->string; Conditionally quoted zone file representation of the text object. =cut my %escape; ## precalculated ASCII/UTF-8 escape table sub string { my $self = shift; my @s = map split( '', $_ ), @$self; # escape non-printable my $string = _decode_utf8( join '', map $escape{$_}, @s ); return $string unless $string =~ /^$|[ \t\n\r\f]/; # unquoted contiguous $string =~ s/\\([$();@])/$1/g; # nothing special within quotes join '', '"', $string, '"'; # quoted string } ######################################## # perlcc: address of encoding objects must be determined at runtime my $ascii = ASCII ? Encode::find_encoding('ascii') : undef; # Osborn's Law: my $utf8 = UTF8 ? Encode::find_encoding('utf8') : undef; # Variables won't; constants aren't. my $decode_ascii = sub { ## ASCII to perl internal encoding my $s = shift; # partial transliteration for non-ASCII character encodings $s =~ tr [\040-\176\000-\377] [ !"#$%&'()*+,-./0-9:;<=>?@A-Z\[\\\]^_`a-z{|}~?] unless ASCII; my $z = length substr $s, 0, 0; # pre-5.18 taint workaround ASCII ? pack( "a* x$z", $ascii->decode($s) ) : $s; }; sub _decode_utf8 { ## UTF-8 to perl internal encoding my $s = shift; UTF8 ? ( $utf8->decode($s) . substr $s, 0, 0 ) : &$decode_ascii($s); } my $encode_ascii = sub { ## perl internal encoding to ASCII my $s = shift; # partial transliteration for non-ASCII character encodings $s =~ tr [ !"#$%&'()*+,-./0-9:;<=>?@A-Z\[\\\]^_`a-z{|}~] [\040-\176] unless ASCII; my $z = length substr $s, 0, 0; # pre-5.18 taint workaround ASCII ? pack( "a* x$z", $ascii->encode($s) ) : $s; }; sub _encode_utf8 { ## perl internal encoding to UTF-8 my $s = shift; my $z = length substr $s, 0, 0; # pre-5.18 taint workaround UTF8 ? pack( "a* x$z", $utf8->encode($s) ) : &$encode_ascii($s); } %escape = eval { ## precalculated ASCII/UTF-8 escape table my %table; my @C0 = ( 0 .. 31 ); # control characters my @NA = UTF8 ? ( 192, 193, 216 .. 223, 245 .. 255 ) : ( 128 .. 255 ); foreach ( 0 .. 255 ) { # transparent $table{pack( 'C', $_ )} = pack 'C', $_; } foreach ( 34, 36, 40, 41, 59, 64, 92 ) { # escape character $table{pack( 'C', $_ )} = pack 'C2', 92, $_; } foreach my $n ( @C0, 127, @NA ) { # \ddd my $codepoint = sprintf( '%03u', $n ); # partial transliteration for non-ASCII character encodings $codepoint =~ tr [0-9] [\060-\071]; $table{pack( 'C', $n )} = pack 'C a3', 92, $codepoint; } return %table; }; %unescape = eval { ## precalculated numeric escape table my %table; foreach my $n ( 0 .. 255 ) { my $key = sprintf( '%03u', $n ); # partial transliteration for non-ASCII character encodings $key =~ tr [0-9] [\060-\071]; $table{$key} = pack 'C', $n; $table{$key} = pack 'C2', 92, $n if $n == 92; # escaped escape } return %table; }; 1; __END__ ######################################## =head1 BUGS Coding strategy is intended to avoid creating unnecessary argument lists and stack frames. This improves efficiency at the expense of code readability. Platform specific character coding features are conditionally compiled into the code. =head1 COPYRIGHT Copyright (c)2009-2011 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, RFC1035, RFC3629, Unicode Technical Report #16 =cut Net-DNS-1.07/lib/Net/DNS/Mailbox.pm0000644000175000017500000000756113031240164016031 0ustar willemwillempackage Net::DNS::Mailbox; # # $Id: Mailbox.pm 1406 2015-10-05 08:25:49Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1406 $)[1]; =head1 NAME Net::DNS::Mailbox - DNS mailbox representation =head1 SYNOPSIS use Net::DNS::Mailbox; $mailbox = new Net::DNS::Mailbox('user@example.com'); $address = $mailbox->address; =head1 DESCRIPTION The Net::DNS::Mailbox module implements a subclass of DNS domain name objects representing the DNS coded form of RFC822 mailbox address. =cut use strict; use integer; use Carp; use base qw(Net::DNS::DomainName); =head1 METHODS =head2 new $mailbox = new Net::DNS::Mailbox('John Doe '); $mailbox = new Net::DNS::Mailbox('john.doe@example.com'); $mailbox = new Net::DNS::Mailbox('john\.doe.example.com'); Creates a mailbox object representing the RFC822 mail address specified by the character string argument. An encoded domain name is also accepted for backward compatibility with Net::DNS 0.68 and earlier. The argument string consists of printable characters from the 7-bit ASCII repertoire. =cut sub new { my $class = shift; local $_ = shift; croak 'undefined mail address' unless defined $_; s/^.*.*$//g; # strip excess on right s/\\\@/\\064/g; # disguise escaped @ s/("[^"]*)\@([^"]*")/$1\\064$2/g; # disguise quoted @ my ( $mbox, @host ) = split /\@/; # split on @ if present for ( $mbox ||= '' ) { s/^.*"(.*)".*$/$1/; # strip quotes s/\\\./\\046/g; # disguise escaped dot s/\./\\046/g if @host; # escape dots in local part } bless __PACKAGE__->SUPER::new( join '.', $mbox, @host ), $class; } =head2 address $address = $mailbox->address; Returns a character string containing the RFC822 mailbox address corresponding to the encoded domain name representation described in RFC1035 section 8. =cut sub address { return unless defined wantarray; my @label = shift->label; local $_ = shift(@label) || return '<>'; s/\\\\//g; # delete escaped \ s/\\\d\d\d//g; # delete non-printable s/\\\./\./g; # unescape dots s/[\\"]//g; # delete \ " s/^(.*)$/"$1"/ if /["(),:;<>@\[\\\]]/; # quote local part return $_ unless scalar(@label); join '@', $_, join '.', @label; } ######################################## =head1 DOMAIN NAME COMPRESSION AND CANONICALISATION The Net::DNS::Mailbox1035 and Net::DNS::Mailbox2535 subclass packages implement RFC1035 domain name compression and RFC2535 canonicalisation. =cut package Net::DNS::Mailbox1035; use base qw(Net::DNS::Mailbox); sub encode { &Net::DNS::DomainName1035::encode; } package Net::DNS::Mailbox2535; use base qw(Net::DNS::Mailbox); sub encode { &Net::DNS::DomainName2535::encode; } 1; __END__ ######################################## =head1 COPYRIGHT Copyright (c)2009,2012 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, RFC1035, RFC5322 (RFC822) =cut Net-DNS-1.07/lib/Net/DNS/RR.pm0000644000175000017500000005204713031240164014760 0ustar willemwillempackage Net::DNS::RR; # # $Id: RR.pm 1519 2016-12-07 11:29:53Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1519 $)[1]; =head1 NAME Net::DNS::RR - DNS resource record base class =head1 SYNOPSIS use Net::DNS; $rr = new Net::DNS::RR('example.com IN A 192.0.2.99'); $rr = new Net::DNS::RR( owner => 'example.com', type => 'A', address => '192.0.2.99' ); =head1 DESCRIPTION Net::DNS::RR is the base class for DNS Resource Record (RR) objects. See also the manual pages for each specific RR type. =cut use strict; use integer; use Carp; use constant LIB => grep !ref($_), @INC; use Net::DNS::Parameters; use Net::DNS::Domain; use Net::DNS::DomainName; =head1 METHODS B Do not assume the RR objects you receive from a query are of a particular type. You must always check the object type before calling any of its methods. If you call an unknown method, you will get an error message and execution will be terminated. =cut sub new { return eval { local $SIG{__DIE__}; scalar @_ > 2 ? &_new_hash : &_new_string; } || do { my $class = shift || __PACKAGE__; my @param = map defined($_) ? split /\s+/ : 'undef', @_; my $stmnt = substr "new $class( @param )", 0, 80; croak "${@}in $stmnt\n"; }; } =head2 new (from string) $a = new Net::DNS::RR('host.example.com. 86400 A 192.0.2.1'); $mx = new Net::DNS::RR('example.com. 7200 MX 10 mailhost.example.com.'); $cname = new Net::DNS::RR('www.example.com 300 IN CNAME host.example.com'); $txt = new Net::DNS::RR('txt.example.com 3600 HS TXT "text data"'); Returns an object of the appropriate RR type, or a L object if the type is not implemented. The attribute values are extracted from the string passed by the user. The syntax of the argument string follows the RFC1035 specification for zone files, and is compatible with the result returned by the string method. The owner and RR type are required; all other information is optional. Omitting the optional fields is useful for creating the empty RDATA sections required for certain dynamic update operations. See the L manual page for additional examples. All names are interpreted as fully qualified domain names. The trailing dot (.) is optional. =cut my $PARSE_REGEX = q/("[^"]*")|;[^\n]*|[ \t\n\r\f()]/; sub _new_string { my $base; local $_; ( $base, $_ ) = @_; croak 'argument absent or undefined' unless defined $_; croak 'non-scalar argument' if ref $_; # parse into quoted strings, contiguous non-whitespace and (discarded) comments s/\\\\/\\092/g; # disguise escaped escape s/\\"/\\034/g; # disguise escaped quote s/\\\(/\\040/g; # disguise escaped bracket s/\\\)/\\041/g; # disguise escaped bracket s/\\;/\\059/g; # disguise escaped semicolon my ( $owner, @token ) = grep defined && length, split /$PARSE_REGEX/o; croak 'unable to parse RR string' unless scalar @token; my $t1 = uc $token[0]; my $t2 = uc $token[1] if $#token; my ( $ttl, $class ); unless ( defined $t2 ) { # @token = ('ANY') if $classbyname{$t1}; # } elsif ( $classbyname{$t1} || $t1 =~ /^CLASS\d/ ) { $class = shift @token; # [] $ttl = shift @token if $t2 =~ /^\d/; } elsif ( $t1 =~ /^\d/ ) { $ttl = shift @token; # [] $class = shift @token if $classbyname{$t2} || $t2 =~ /^CLASS\d/; } my $type = shift(@token); my $populated = scalar @token; my $self = $base->_subclass( $type, $populated ); # create RR object $self->owner($owner); $self->class($class) if defined $class; # specify CLASS $self->ttl($ttl) if defined $ttl; # specify TTL return $self unless $populated; # empty RR if ( $#token && $token[0] =~ /^[\\]?#$/ ) { shift @token; # RFC3597 hexadecimal format my $count = shift(@token) || 0; my $rdata = pack 'H*', join '', @token; my $rdlen = $self->{rdlength} = length $rdata; croak 'length and hexadecimal data inconsistent' unless $rdlen == $count; $self->_decode_rdata( \$rdata, 0 ) if $rdlen; # unpack RDATA return $self; } $self->_parse_rdata(@token); # parse arguments return $self; } =head2 new (from hash) $rr = new Net::DNS::RR(%hash); $rr = new Net::DNS::RR( owner => 'host.example.com', ttl => 86400, class => 'IN', type => 'A', address => '192.0.2.1' ); $rr = new Net::DNS::RR( owner => 'txt.example.com', type => 'TXT', txtdata => [ 'one', 'two' ] ); Returns an object of the appropriate RR type, or a L object if the type is not implemented. Consult the relevant manual pages for the usage of type specific attributes. The owner and RR type are required; all other information is optional. Omitting optional attributes is useful for creating the empty RDATA sections required for certain dynamic update operations. =cut sub _new_hash { my ( $base, %argument ) = @_; my %attribute = ( owner => '.', type => 'ANY' ); while ( my ( $key, $value ) = each %argument ) { $attribute{lc $key} = $value; } my ( $owner, $type, $class, $ttl ) = @attribute{qw(owner type class ttl)}; $owner = $attribute{name} if exists $attribute{name}; # synonym for owner delete @attribute{qw(owner name class type ttl rdlength)}; my $populated = scalar %attribute; # RDATA specified my $self = $base->_subclass( $type, $populated ); # RR with defaults (if appropriate) $self->owner($owner); $self->class($class) if defined $class; # specify CLASS $self->ttl($ttl) if defined $ttl; # specify TTL while ( my ( $attribute, $value ) = each %attribute ) { $self->$attribute( ref($value) eq 'ARRAY' ? @$value : $value ); } return $self; } =head2 decode ( $rr, $next ) = decode Net::DNS::RR( \$data, $offset, @opaque ); Decodes a DNS resource record at the specified location within a DNS packet. The argument list consists of a reference to the buffer containing the packet data and offset indicating where resource record begins. Remaining arguments, if any, are passed as opaque data to subordinate decoders. Returns a C object and the offset of the next record in the packet. An exception is raised if the data buffer contains insufficient or corrupt data. Any remaining arguments are passed as opaque data to subordinate decoders and do not form part of the published interface. =cut use constant RRFIXEDSZ => length pack 'n2 N n', (0) x 4; sub decode { my $base = shift; my ( $data, $offset, @opaque ) = @_; my ( $owner, $fixed ) = decode Net::DNS::DomainName1035(@_); my $index = $fixed + RRFIXEDSZ; die 'corrupt wire-format data' if length $$data < $index; my $self = $base->_subclass( unpack "\@$fixed n", $$data ); $self->{owner} = $owner; @{$self}{qw(class ttl rdlength)} = unpack "\@$fixed x2 n N n", $$data; my $next = $index + $self->{rdlength}; die 'corrupt wire-format data' if length $$data < $next; $self->{offset} = $offset || 0; $self->_decode_rdata( $data, $index, @opaque ) if $next > $index or $self->type eq 'OPT'; delete $self->{offset}; return wantarray ? ( $self, $next ) : $self; } =head2 encode $data = $rr->encode( $offset, @opaque ); Returns the C in binary format suitable for inclusion in a DNS packet buffer. The offset indicates the intended location within the packet data where the C is to be stored. Any remaining arguments are opaque data which are passed intact to subordinate encoders. =cut sub encode { my $self = shift; my ( $offset, @opaque ) = scalar(@_) ? @_ : ( 0x4000, {} ); my $owner = $self->{owner}->encode( $offset, @opaque ); my $type = $self->{type}; my $class = $self->{class} || 1; my $index = $offset + length($owner) + RRFIXEDSZ; my $rdata = eval { $self->_encode_rdata( $index, @opaque ); } || ''; return pack 'a* n2 N n a*', $owner, $type, $class, $self->ttl, length $rdata, $rdata; } =head2 canonical $data = $rr->canonical; Returns the C in canonical binary format suitable for DNSSEC signature validation. The absence of the associative array argument signals to subordinate encoders that the canonical uncompressed lower case form of embedded domain names is to be used. =cut sub canonical { my $self = shift; my $owner = $self->{owner}->canonical; my $type = $self->{type}; my $class = $self->{class} || 1; my $index = RRFIXEDSZ + length $owner; my $rdata = eval { $self->_encode_rdata($index); } || ''; pack 'a* n2 N n a*', $owner, $type, $class, $self->ttl, length $rdata, $rdata; } =head2 print $rr->print; Prints the record to the standard output. Calls the string method to get the formatted RR representation. =cut sub print { print shift->string, "\n"; } =head2 string print $rr->string, "\n"; Returns a string representation of the RR using the zone file format described in RFC1035. All domain names are fully qualified with trailing dot. This differs from RR attribute methods, which omit the trailing dot. =cut sub string { my $self = shift; my $name = $self->{owner}->string; my @ttl = grep defined, $self->{ttl}; my @core = ( $name, @ttl, $self->class, $self->type ); my @rdata = eval { $self->_format_rdata; }; carp $@ if $@; my $tab = length($name) < 72 ? "\t" : ' '; return join $tab, @core, '; no data' unless scalar @rdata; my @note = map "; $_", $self->_annotation; my @line = _wrap( join( $tab, @core, '(' ), @rdata, ')' ); return join "\n\t", @line, @note if scalar(@line) > 1; # multi-line RR for (@line) { # single line RR s/\s+[(]\s*/\t/; # strip redundant ( ) s/\s+[)]$//; return join "\n\t", $_, @note; } } =head2 plain $plain = $rr->plain; Returns a simplified single line representation of the RR using the zone file format defined in RFC1035. This facilitates interaction with programs like nsupdate which have rudimentary RR parsers. =cut sub plain { join ' ', shift->token; } =head2 token @token = $rr->token; Returns a token list representation of the RR zone file string. =cut sub token { my $self = shift; my @ttl = grep defined, $self->{ttl}; my @core = ( $self->{owner}->string, @ttl, $self->class, $self->type ); # parse into quoted strings, contiguous non-whitespace and (discarded) comments local $_ = join ' ', eval { $self->_format_rdata; }; s/\\\\/\\092/g; # disguise escaped escape s/\\"/\\034/g; # disguise escaped quote s/\\\(/\\040/g; # disguise escaped bracket s/\\\)/\\041/g; # disguise escaped bracket s/\\;/\\059/g; # disguise escaped semicolon my @token = @core, grep defined && length, split /$PARSE_REGEX/o; } =head2 generic $generic = $rr->generic; Returns the generic RR representation defined in RFC3597. This facilitates creation of zone files containing RRs unrecognised by outdated nameservers and provisioning software. =cut sub generic { my $self = shift; my @ttl = grep defined, $self->{ttl}; my @class = map "CLASS$_", grep defined, $self->{class}; my @core = ( $self->{owner}->string, @ttl, @class, "TYPE$self->{type}" ); my $data = $self->rdata; my $size = length($data); join ' ', @core, '\\#', $size, unpack 'H*', $data; } =head2 owner name $name = $rr->owner; Returns the owner name of the record. =cut sub owner { my $self = shift; $self->{owner} = new Net::DNS::DomainName1035(shift) if scalar @_; $self->{owner}->name if defined wantarray; } sub name { &owner; } ## historical =head2 type $type = $rr->type; Returns the record type. =cut sub type { my $self = shift; croak 'not possible to change RR->type' if scalar @_; typebyval( $self->{type} ); } =head2 class $class = $rr->class; Resource record class. =cut sub class { my $self = shift; $self->{class} = classbyname(shift) if scalar @_; classbyval( $self->{class} || 1 ) if defined wantarray; } =head2 ttl $ttl = $rr->ttl; $ttl = $rr->ttl(3600); Resource record time to live in seconds. =cut # The following time units are recognised, but are not part of the # published API. These are required for parsing BIND zone files but # should not be used in other contexts. my %unit = ( W => 604800, D => 86400, H => 3600, M => 60, S => 1 ); %unit = ( %unit, map /\D/ ? lc($_) : $_, %unit ); sub ttl { my ( $self, $time ) = @_; return $self->{ttl} || 0 unless defined $time; # avoid defining rr->{ttl} my $ttl = 0; my %time = reverse split /(\D)\D*/, $time . 'S'; while ( my ( $u, $t ) = each %time ) { my $scale = $unit{$u} || die qq(bad time: $t$u); $ttl += $t * $scale; } $self->{ttl} = $ttl; } ################################################################################ ## ## Default implementation for unknown RR type ## ################################################################################ sub _decode_rdata { ## decode rdata from wire-format octet string my ( $self, $data, $offset ) = @_; $self->{rdata} = substr $$data, $offset, $self->{rdlength}; } sub _encode_rdata { ## encode rdata as wire-format octet string my $rdata = shift->{rdata}; return defined $rdata ? $rdata : ''; } sub _format_rdata { ## format rdata portion of RR string my $self = shift; my $data = $self->_encode_rdata; my $size = length($data) || return ''; join ' ', '\\#', $size, unpack 'H*', $data; # RFC3597 unknown RR format } sub _parse_rdata { ## parse RR attributes in argument list my $self = shift; die join ' ', $self->type, 'not implemented' if ref($self) eq __PACKAGE__; die join ' ', 'no zone file representation defined for', $self->type; } sub _defaults { } ## set attribute default values sub dump { ## print internal data structure require Data::Dumper; # uncoverable pod local $Data::Dumper::Maxdepth = $Data::Dumper::Maxdepth || 6; local $Data::Dumper::Sortkeys = $Data::Dumper::Sortkeys || 1; print Data::Dumper::Dumper(@_); } sub rdatastr { ## historical RR subtype method &rdstring; # uncoverable pod } =head2 rdata $rr = new Net::DNS::RR( type => NULL, rdata => 'arbitrary' ); Resource record data section when viewed as opaque octets. =cut sub rdata { my $self = shift; return eval { $self->_encode_rdata( 0x4000, {} ); } unless scalar @_; my $rdata = shift; my $rdlen = $self->{rdlength} = length $rdata; my $hash = {}; $self->_decode_rdata( \$rdata, 0, $hash ) if $rdlen; croak 'found compression pointer in rdata' if keys %$hash; } =head2 rdstring $rdstring = $rr->rdstring; Returns a string representation of the RR-specific data. =cut sub rdstring { my $self = shift; my @rdata = eval { $self->_format_rdata; }; carp $@ if $@; join "\n\t", _wrap(@rdata); } =head2 rdlength $rdlength = $rr->rdlength; Returns the length of the encoded RR-specific data. =cut sub rdlength { length shift->_encode_rdata; } ################################################################################### =head1 Sorting of RR arrays Sorting of RR arrays is done by Net::DNS::rrsort(), see documentation for L. This package provides class methods to set the comparator function used for a particular RR based on its attributes. =head2 set_rrsort_func my $function = sub { ## numerically ascending order $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; Net::DNS::RR::MX->set_rrsort_func( 'preference', $function ); Net::DNS::RR::MX->set_rrsort_func( 'default_sort', $function ); set_rrsort_func() must be called as a class method. The first argument is the attribute name on which the sorting is to take place. If you specify "default_sort" then that is the sort algorithm that will be used when get_rrsort_func() is called without an RR attribute as argument. The second argument is a reference to a comparator function that uses the global variables $a and $b in the Net::DNS package. During sorting, the variables $a and $b will contain references to objects of the class whose set_rrsort_func() was called. The above sorting function will only be applied to Net::DNS::RR::MX objects. The above example is the sorting function implemented in MX. =cut use vars qw(%rrsortfunct); sub set_rrsort_func { my $class = shift; my $attribute = shift; my $function = shift; my ($type) = $class =~ m/::([^:]+)$/; $rrsortfunct{$type}{$attribute} = $function; } =head2 get_rrsort_func $function = Net::DNS::RR::MX->get_rrsort_func('preference'); $function = Net::DNS::RR::MX->get_rrsort_func(); get_rrsort_func() returns a reference to the comparator function. =cut my $default = sub { $Net::DNS::a->canonical() cmp $Net::DNS::b->canonical(); }; sub get_rrsort_func { my $class = shift; my $attribute = shift || 'default_sort'; my ($type) = $class =~ m/::([^:]+)$/; $rrsortfunct{$type}{$attribute} || $default; } ################################################################################ # # Net::DNS::RR->_subclass($rrname) # Net::DNS::RR->_subclass($rrname, $default) # # Create a new object blessed into appropriate RR subclass, after # loading the subclass module (if necessary). A subclass with no # corresponding module will be regarded as unknown and blessed # into the RR base class. # # The optional second argument indicates that default values are # to be copied into the newly created object. use vars qw(%_LOADED %_MINIMAL); $_MINIMAL{ANY} = bless ['type' => 255], __PACKAGE__; %_LOADED = %_MINIMAL; sub _subclass { my $class = shift; my $rrname = shift; my $default = shift; unless ( $_LOADED{$rrname} ) { local @INC = LIB; my $rrtype = typebyname($rrname); unless ( $_LOADED{$rrtype} ) { # load once only my $mnemon = typebyval($rrtype); $mnemon =~ s/[^A-Za-z0-9]//g; # expect the unexpected my $subclass = join '::', __PACKAGE__, $mnemon; unless ( eval "require $subclass" ) { push @INC, sub { Net::DNS::Parameters::_typespec("$rrtype.RRTYPE"); }; $subclass = join '::', __PACKAGE__, "TYPE$rrtype"; eval "require $subclass"; } $subclass = __PACKAGE__ if $@; # cache pre-built minimal and populated default object images my @base = ( 'type' => $rrtype ); $_MINIMAL{$rrtype} = bless [@base], $subclass; my $object = bless {@base}, $subclass; $object->_defaults; $_LOADED{$rrtype} = bless [%$object], $subclass; } $_MINIMAL{$rrname} = $_MINIMAL{$rrtype}; $_LOADED{$rrname} = $_LOADED{$rrtype}; } my $prebuilt = $default ? $_LOADED{$rrname} : $_MINIMAL{$rrname}; bless {@$prebuilt}, ref($prebuilt); # create object } sub _annotation { my $self = shift; $self->{annotation} = ["@_"] if scalar @_; return @{$self->{annotation} || []} if wantarray; } sub _wrap { my @text = @_; my $cols = 80; my $coln = 0; my ( @line, @fill ); foreach (@text) { if ( ( $coln += 1 + length ) > $cols ) { # start new line push @line, join ' ', @fill if scalar @fill; $coln = length; @fill = (); } $coln = $cols if chomp; # force line break push( @fill, $_ ); } push @line, join ' ', @fill; return @line; } ################################################################################ use vars qw($AUTOLOAD); sub DESTROY { } ## Avoid tickling AUTOLOAD (in cleanup) sub AUTOLOAD { ## Default method my $self = shift; my $oref = ref($self); no strict q/refs/; my ($method) = reverse split /::/, $AUTOLOAD; *{$AUTOLOAD} = sub {undef}; ## suppress repetition and deep recursion croak "$self has no class method '$method'" unless $oref; my $string = $self->string; my @object = grep defined($_), $oref, $oref->VERSION; my $module = join '::', __PACKAGE__, typebyval( $self->{type} ); eval("require $module") if $oref eq __PACKAGE__; @_ = (<<"END"); *** FATAL PROGRAM ERROR!! Unknown method '$method' *** which the program has attempted to call for the object: *** $string *** *** @object has no instance method '$method' *** $@ *** THIS IS A BUG IN THE CALLING SOFTWARE, which incorrectly assumes *** that the object would be of a particular type. The type of an *** object should be checked before calling any of its methods. END goto &{'Carp::confess'}; } 1; __END__ =head1 COPYRIGHT Copyright (c)1997-2001 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. Portions Copyright (c)2005-2007 Olaf Kolkman. Portions Copyright (c)2007,2012 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, L, RFC1035 Section 4.1.3, RFC1123, RFC3597 =cut Net-DNS-1.07/lib/Net/DNS/Nameserver.pm0000644000175000017500000005670213031240164016546 0ustar willemwillempackage Net::DNS::Nameserver; # # $Id: Nameserver.pm 1493 2016-08-22 08:28:50Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1493 $)[1]; =head1 NAME Net::DNS::Nameserver - DNS server class =head1 SYNOPSIS use Net::DNS::Nameserver; $nameserver = new Net::DNS::Nameserver( LocalAddr => ['::1' , '127.0.0.1' ], LocalPort => "5353", ReplyHandler => \&reply_handler, Verbose => 1, Truncate => 0 ); =head1 DESCRIPTION Instances of the C class represent DNS server objects. See L for an example. =cut use strict; use integer; use Carp qw(cluck); use Net::DNS; use IO::Socket; use IO::Socket::INET; use IO::Select; use constant FORCE_INET4 => 0; use constant DEFAULT_ADDR => 0; use constant DEFAULT_PORT => 53; use constant STATE_ACCEPTED => 1; use constant STATE_GOT_LENGTH => 2; use constant STATE_SENDING => 3; use constant PACKETSZ => 512; use vars qw($has_inet6); BEGIN { $has_inet6 = eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION("2.01"); 1; } || 0; $has_inet6 = 0 if FORCE_INET4; } #------------------------------------------------------------------------------ # Constructor. #------------------------------------------------------------------------------ sub new { my ( $class, %self ) = @_; my $self = bless \%self, $class; if ( !exists $self{ReplyHandler} ) { if ( my $handler = UNIVERSAL::can( $class, "ReplyHandler" ) ) { $self{ReplyHandler} = sub { $handler->( $self, @_ ); }; } } unless ( ref $self{ReplyHandler} eq "CODE" ) { cluck "No reply handler!"; return undef; } # local server addresses must also be accepted by a resolver my @LocalAddr = ref $self{LocalAddr} ? @{$self{LocalAddr}} : ( $self{LocalAddr} || DEFAULT_ADDR ); my $resolver = new Net::DNS::Resolver( nameservers => [@LocalAddr] ); $resolver->force_v4(1) unless $has_inet6; my @localaddresses = $resolver->nameservers; my $port = $self{LocalPort} || DEFAULT_PORT; $self{Truncate} = 1 unless defined( $self{Truncate} ); $self{IdleTimeout} = 120 unless defined( $self{IdleTimeout} ); my @sock_tcp; # All the TCP sockets we will listen to. my @sock_udp; # All the UDP sockets we will listen to. # while we are here, print incomplete lines as they come along. local $| = 1 if $self{Verbose}; foreach my $addr (@localaddresses) { #-------------------------------------------------------------------------- # Create the TCP socket. #-------------------------------------------------------------------------- print "\nCreating TCP socket $addr#$port - " if $self{Verbose}; my $sock_tcp = inet_new( LocalAddr => $addr, LocalPort => $port, Listen => 64, Proto => "tcp", Reuse => 1, Blocking => 0, ); if ($sock_tcp) { push @sock_tcp, $sock_tcp; print "done.\n" if $self{Verbose}; } else { cluck "Couldn't create TCP socket: $!"; } #-------------------------------------------------------------------------- # Create the UDP Socket. #-------------------------------------------------------------------------- print "Creating UDP socket $addr#$port - " if $self{Verbose}; my $sock_udp = inet_new( LocalAddr => $addr, LocalPort => $port, Proto => "udp", ); if ($sock_udp) { push @sock_udp, $sock_udp; print "done.\n" if $self{Verbose}; } else { cluck "Couldn't create UDP socket: $!"; } } #-------------------------------------------------------------------------- # Create the Select object. #-------------------------------------------------------------------------- my $select = $self{select} = new IO::Select; $select->add(@sock_tcp); $select->add(@sock_udp); return undef unless $select->count; #-------------------------------------------------------------------------- # Return the object. #-------------------------------------------------------------------------- return $self; } #------------------------------------------------------------------------------ # inet_new - Calls the constructor in the correct module for making sockets. #------------------------------------------------------------------------------ sub inet_new { if ($has_inet6) { return new IO::Socket::INET6(@_); } else { return new IO::Socket::INET(@_); } } #------------------------------------------------------------------------------ # make_reply - Make a reply packet. #------------------------------------------------------------------------------ sub make_reply { my ( $self, $query, $peerhost, $conn ) = @_; unless ($query) { print "ERROR: invalid packet\n" if $self->{Verbose}; my $empty = new Net::DNS::Packet(); # create empty reply packet my $reply = $empty->reply(); $reply->header->rcode("FORMERR"); return $reply; } if ( $query->header->qr() ) { print "ERROR: invalid packet (qr set), dropping\n" if $self->{Verbose}; return; } my $reply = $query->reply(); my $header = $reply->header; my $headermask; my $opcode = $query->header->opcode; my $qdcount = $query->header->qdcount; unless ($qdcount) { $header->rcode("NOERROR"); } elsif ( $qdcount > 1 ) { print "ERROR: qdcount $qdcount unsupported\n" if $self->{Verbose}; $header->rcode("FORMERR"); } else { my ($qr) = $query->question; my $qname = $qr->qname; my $qtype = $qr->qtype; my $qclass = $qr->qclass; my $id = $query->header->id; print "query $id : $qname $qclass $qtype - " if $self->{Verbose}; my ( $rcode, $ans, $auth, $add ); my @arglist = ( $qname, $qclass, $qtype, $peerhost, $query, $conn ); if ( $opcode eq "QUERY" ) { ( $rcode, $ans, $auth, $add, $headermask ) = &{$self->{ReplyHandler}}(@arglist); } elsif ( $opcode eq "NOTIFY" ) { #RFC1996 if ( ref $self->{NotifyHandler} eq "CODE" ) { ( $rcode, $ans, $auth, $add, $headermask ) = &{$self->{NotifyHandler}}(@arglist); } else { $rcode = "NOTIMP"; } } else { print "ERROR: opcode $opcode unsupported\n" if $self->{Verbose}; $rcode = "FORMERR"; } if ( !defined($rcode) ) { print "remaining silent\n" if $self->{Verbose}; return undef; } $header->rcode($rcode); $reply->{answer} = [@$ans] if $ans; $reply->{authority} = [@$auth] if $auth; $reply->{additional} = [@$add] if $add; } while ( my ( $key, $value ) = each %{$headermask || {}} ) { $header->$key($value); } $header->print if $self->{Verbose} && defined $headermask; return $reply; } #------------------------------------------------------------------------------ # readfromtcp - read from a TCP client #------------------------------------------------------------------------------ sub readfromtcp { my ( $self, $sock ) = @_; return -1 unless defined $self->{_tcp}{$sock}; my $peer = $self->{_tcp}{$sock}{peer}; my $buf; my $charsread = $sock->sysread( $buf, 16384 ); $self->{_tcp}{$sock}{inbuffer} .= $buf; $self->{_tcp}{$sock}{timeout} = time() + $self->{IdleTimeout}; # Reset idle timer print "Received $charsread octets from $peer\n" if $self->{Verbose}; if ( $charsread == 0 ) { # 0 octets means socket has closed print "Connection to $peer closed or lost.\n" if $self->{Verbose}; $self->{select}->remove($sock); $sock->close(); delete $self->{_tcp}{$sock}; return $charsread; } return $charsread; } #------------------------------------------------------------------------------ # tcp_connection - Handle a TCP connection. #------------------------------------------------------------------------------ sub tcp_connection { my ( $self, $sock ) = @_; if ( not $self->{_tcp}{$sock} ) { # We go here if we are called with a listener socket. my $client = $sock->accept; if ( not defined $client ) { print "TCP connection closed by peer before we could accept it.\n" if $self->{Verbose}; return 0; } my $peerport = $client->peerport; my $peerhost = $client->peerhost; print "TCP connection from $peerhost:$peerport\n" if $self->{Verbose}; $client->blocking(0); $self->{_tcp}{$client}{peer} = "tcp:" . $peerhost . ":" . $peerport; $self->{_tcp}{$client}{state} = STATE_ACCEPTED; $self->{_tcp}{$client}{socket} = $client; $self->{_tcp}{$client}{timeout} = time() + $self->{IdleTimeout}; $self->{select}->add($client); # After we accepted we will look at the socket again # to see if there is any data there. ---Olaf $self->loop_once(0); } else { # We go here if we are called with a client socket my $peer = $self->{_tcp}{$sock}{peer}; if ( $self->{_tcp}{$sock}{state} == STATE_ACCEPTED ) { if ( not $self->{_tcp}{$sock}{inbuffer} =~ s/^(..)//s ) { return; # Still not 2 octets ready } my $msglen = unpack( "n", $1 ); print "Removed 2 octets from the input buffer from $peer.\n" . "$peer said his query contains $msglen octets.\n" if $self->{Verbose}; $self->{_tcp}{$sock}{state} = STATE_GOT_LENGTH; $self->{_tcp}{$sock}{querylength} = $msglen; } # Not elsif, because we might already have all the data if ( $self->{_tcp}{$sock}{state} == STATE_GOT_LENGTH ) { # return if not all data has been received yet. return if $self->{_tcp}{$sock}{querylength} > length $self->{_tcp}{$sock}{inbuffer}; my $qbuf = substr( $self->{_tcp}{$sock}{inbuffer}, 0, $self->{_tcp}{$sock}{querylength} ); substr( $self->{_tcp}{$sock}{inbuffer}, 0, $self->{_tcp}{$sock}{querylength} ) = ""; my $query = new Net::DNS::Packet( \$qbuf ); if ( my $err = $@ ) { print "Error decoding query packet: $err\n" if $self->{Verbose}; undef $query; # force FORMERR reply } my $conn = { sockhost => $sock->sockhost, sockport => $sock->sockport, peerhost => $sock->peerhost, peerport => $sock->peerport }; my $reply = $self->make_reply( $query, $sock->peerhost, $conn ); if ( not defined $reply ) { print "I couldn't create a reply for $peer. Closing socket.\n" if $self->{Verbose}; $self->{select}->remove($sock); $sock->close(); delete $self->{_tcp}{$sock}; return; } my $reply_data = $reply->data; my $len = length $reply_data; $self->{_tcp}{$sock}{outbuffer} = pack( "n", $len ) . $reply_data; print "Queued ", length $self->{_tcp}{$sock}{outbuffer}, " octets to $peer\n" if $self->{Verbose}; # We are done. $self->{_tcp}{$sock}{state} = STATE_SENDING; } } } #------------------------------------------------------------------------------ # udp_connection - Handle a UDP connection. #------------------------------------------------------------------------------ sub udp_connection { my ( $self, $sock ) = @_; my $buf = ""; $sock->recv( $buf, PACKETSZ ); my ( $peerhost, $peerport, $sockhost ) = ( $sock->peerhost, $sock->peerport, $sock->sockhost ); unless ( defined $peerhost && defined $peerport ) { print "the Peer host and sock host appear to be undefined: bailing out of handling the UDP connection" if $self->{Verbose}; return; } print "UDP connection from $peerhost:$peerport to $sockhost\n" if $self->{Verbose}; my $query = new Net::DNS::Packet( \$buf, $self->{Verbose} ); if ( my $err = $@ ) { print "Error decoding query packet: $err\n" if $self->{Verbose}; undef $query; # force FORMERR reply } my $conn = { sockhost => $sock->sockhost, sockport => $sock->sockport, peerhost => $sock->peerhost, peerport => $sock->peerport }; my $reply = $self->make_reply( $query, $peerhost, $conn ) || return; my $max_len = ( $query && $self->{Truncate} ) ? $query->edns->size : undef; if ( $self->{Verbose} ) { local $| = 1; print "Maximum UDP size advertised by $peerhost:$peerport: $max_len\n" if $max_len; print "Writing response - "; print $sock->send( $reply->data($max_len) ) ? "done" : "failed: $!", "\n"; } else { $sock->send( $reply->data($max_len) ); } } sub get_open_tcp { my $self = shift; return keys %{$self->{_tcp}}; } #------------------------------------------------------------------------------ # loop_once - Just check "once" on sockets already set up #------------------------------------------------------------------------------ # This function might not actually return immediately. If an AXFR request is # coming in which will generate a huge reply, we will not relinquish control # until our outbuffers are empty. # # NB this method may be subject to change and is therefore left 'undocumented' # sub loop_once { my ( $self, $timeout ) = @_; print ";loop_once called with timeout: " . ( defined($timeout) ? $timeout : "undefined" ) . "\n" if $self->{Verbose} && $self->{Verbose} > 4; foreach my $sock ( keys %{$self->{_tcp}} ) { # There is TCP traffic to handle $timeout = 0.1 if $self->{_tcp}{$sock}{outbuffer}; } my @ready = $self->{select}->can_read($timeout); foreach my $sock (@ready) { my $protonum = $sock->protocol; # This is a weird and nasty hack. Although not incorrect, # I just don't know why ->protocol won't tell me the protocol # on a connected socket. --robert $protonum = getprotobyname('tcp') if not defined $protonum and $self->{_tcp}{$sock}; my $proto = getprotobynumber($protonum); if ( !$proto ) { print "ERROR: connection with unknown protocol\n" if $self->{Verbose}; } elsif ( lc($proto) eq "tcp" ) { $self->readfromtcp($sock) && $self->tcp_connection($sock); } elsif ( lc($proto) eq "udp" ) { $self->udp_connection($sock); } else { print "ERROR: connection with unsupported protocol $proto\n" if $self->{Verbose}; } } my $now = time(); # Lets check if any of our TCP clients has pending actions. # (outbuffer, timeout) foreach my $s ( keys %{$self->{_tcp}} ) { my $sock = $self->{_tcp}{$s}{socket}; if ( $self->{_tcp}{$s}{outbuffer} ) { # If we have buffered output, then send as much as the OS will accept # and wait with the rest my $len = length $self->{_tcp}{$s}{outbuffer}; my $charssent = $sock->syswrite( $self->{_tcp}{$s}{outbuffer} ) || 0; print "Sent $charssent of $len octets to ", $self->{_tcp}{$s}{peer}, ".\n" if $self->{Verbose}; substr( $self->{_tcp}{$s}{outbuffer}, 0, $charssent ) = ""; if ( length $self->{_tcp}{$s}{outbuffer} == 0 ) { delete $self->{_tcp}{$s}{outbuffer}; $self->{_tcp}{$s}{state} = STATE_ACCEPTED; if ( length $self->{_tcp}{$s}{inbuffer} >= 2 ) { # See if the client has send us enough data to process the # next query. # We do this here, because we only want to process (and buffer!!) # a single query at a time, per client. If we allowed a STATE_SENDING # client to have new requests processed. We could be easilier # victims of DoS (client sending lots of queries and never reading # from it's socket). # Note that this does not disable serialisation on part of the # client. The split second it should take for us to lookup the # next query, is likely faster than the time it takes to # send the response... well, unless it's a lot of tiny queries, # in which case we will be generating an entire TCP packet per # reply. --robert $self->tcp_connection( $self->{_tcp}{$s}{socket} ); } } $self->{_tcp}{$s}{timeout} = time() + $self->{IdleTimeout}; } else { # Get rid of idle clients. my $timeout = $self->{_tcp}{$s}{timeout}; if ( $timeout - $now < 0 ) { print $self->{_tcp}{$s}{peer}, " has been idle for too long and will be disconnected.\n" if $self->{Verbose}; $self->{select}->remove($sock); $sock->close(); delete $self->{_tcp}{$s}; } } } } #------------------------------------------------------------------------------ # main_loop - Main nameserver loop. #------------------------------------------------------------------------------ sub main_loop { my $self = shift; while (1) { print "Waiting for connections...\n" if $self->{Verbose}; # You really need an argument otherwise you'll be burning CPU. $self->loop_once(10); } } 1; __END__ =head1 METHODS =head2 new my $ns = new Net::DNS::Nameserver( LocalAddr => "10.1.2.3", LocalPort => "5353", ReplyHandler => \&reply_handler, Verbose => 1 ); my $ns = new Net::DNS::Nameserver( LocalAddr => ['::1' , '127.0.0.1' ], LocalPort => "5353", ReplyHandler => \&reply_handler, Verbose => 1, Truncate => 0 ); Returns a Net::DNS::Nameserver object, or undef if the object could not be created. Attributes are: LocalAddr IP address on which to listen. Defaults to INADDR_ANY. LocalPort Port on which to listen. Defaults to 53. ReplyHandler Reference to reply-handling subroutine Required. NotifyHandler Reference to reply-handling subroutine for queries with opcode NOTIFY (RFC1996) Verbose Print info about received queries. Defaults to 0 (off). Truncate Truncates UDP packets that are too big for the reply Defaults to 1 (on) IdleTimeout TCP clients are disconnected if they are idle longer than this duration. Defaults to 120 (secs) The LocalAddr attribute may alternatively be specified as a list of IP addresses to listen to. If IO::Socket::INET6 and Socket6 are available on the system you can also list IPv6 addresses and the default is '0' (listen on all interfaces on IPv6 and IPv4); The ReplyHandler subroutine is passed the query name, query class, query type and optionally an argument containing the peerhost, the incoming query, and the name of the incoming socket (sockethost). It must either return the response code and references to the answer, authority, and additional sections of the response, or undef to leave the query unanswered. Common response codes are: NOERROR No error FORMERR Format error SERVFAIL Server failure NXDOMAIN Non-existent domain (name doesn't exist) NOTIMP Not implemented REFUSED Query refused For advanced usage it may also contain a headermask containing an hashref with the settings for the C, C, and C header bits. The argument is of the form C<< { ad => 1, aa => 0, ra => 1 } >>. See RFC 1035 and the IANA dns-parameters file for more information: ftp://ftp.rfc-editor.org/in-notes/rfc1035.txt http://www.isi.edu/in-notes/iana/assignments/dns-parameters The nameserver will listen for both UDP and TCP connections. On Unix-like systems, the program will probably have to run as root to listen on the default port, 53. A non-privileged user should be able to listen on ports 1024 and higher. UDP reply truncation functionality was introduced in VERSION 830. The size limit is determined by the EDNS0 size advertised in the query, otherwise 512 is used. If you want to do packet truncation yourself you should set C to 0 and truncate the reply packet in the code of the ReplyHandler. See L for an example. =head2 main_loop $ns->main_loop; Start accepting queries. Calling main_loop never returns. =head2 loop_once $ns->loop_once( [TIMEOUT_IN_SECONDS] ); Start accepting queries, but returns. If called without a parameter, the call will not return until a request has been received (and replied to). Otherwise, the parameter specifies the maximum time to wait for a request. A zero timeout forces an immediate return if there is nothing to do. Handling a request and replying obviously depends on the speed of ReplyHandler. Assuming a fast ReplyHandler, loop_once should spend just a fraction of a second, if called with a timeout value of 0.0 seconds. One exception is when an AXFR has requested a huge amount of data that the OS is not ready to receive in full. In that case, it will remain in a loop (while servicing new requests) until the reply has been sent. In case loop_once accepted a TCP connection it will immediately check if there is data to be read from the socket. If not it will return and you will have to call loop_once() again to check if there is any data waiting on the socket to be processed. In most cases you will have to count on calling "loop_once" twice. A code fragment like: $ns->loop_once(10); while( $ns->get_open_tcp() ){ $ns->loop_once(0); } Would wait for 10 seconds for the initial connection and would then process all TCP sockets until none is left. =head2 get_open_tcp In scalar context returns the number of TCP connections for which state is maintained. In array context it returns IO::Socket objects, these could be useful for troubleshooting but be careful using them. =head1 EXAMPLE The following example will listen on port 5353 and respond to all queries for A records with the IP address 10.1.2.3. All other queries will be answered with NXDOMAIN. Authority and additional sections are left empty. The $peerhost variable catches the IP address of the peer host, so that additional filtering on its basis may be applied. #!/usr/bin/perl use strict; use warnings; use Net::DNS::Nameserver; sub reply_handler { my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_; my ($rcode, @ans, @auth, @add); print "Received query from $peerhost to ". $conn->{sockhost}. "\n"; $query->print; if ($qtype eq "A" && $qname eq "foo.example.com" ) { my ($ttl, $rdata) = (3600, "10.1.2.3"); my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata"); push @ans, $rr; $rcode = "NOERROR"; }elsif( $qname eq "foo.example.com" ) { $rcode = "NOERROR"; }else{ $rcode = "NXDOMAIN"; } # mark the answer as authoritative (by setting the 'aa' flag return ($rcode, \@ans, \@auth, \@add, { aa => 1 }); } my $ns = new Net::DNS::Nameserver( LocalPort => 5353, ReplyHandler => \&reply_handler, Verbose => 1 ) || die "couldn't create nameserver object\n"; $ns->main_loop; =head1 BUGS Limitations in perl 5.8.6 makes it impossible to guarantee that replies to UDP queries from Net::DNS::Nameserver are sent from the IP-address they were received on. This is a problem for machines with multiple IP-addresses and causes violation of RFC2181 section 4. Thus a UDP socket created listening to INADDR_ANY (all available IP-addresses) will reply not necessarily with the source address being the one to which the request was sent, but rather with the address that the operating system chooses. This is also often called "the closest address". This should really only be a problem on a server which has more than one IP-address (besides localhost - any experience with IPv6 complications here, would be nice). If this is a problem for you, a work-around would be to not listen to INADDR_ANY but to specify each address that you want this module to listen on. A separate set of sockets will then be created for each IP-address. =head1 COPYRIGHT Copyright (c)2000 Michael Fuhr. Portions Copyright (c)2002-2004 Chris Reinhardt. Portions Copyright (c)2005 Robert Martin-Legene. Portions Copyright (c)2005-2009 O.M, Kolkman, RIPE NCC. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, L, L, L, L, RFC 1035 =cut Net-DNS-1.07/lib/Net/DNS/Update.pm0000644000175000017500000001733513031240164015660 0ustar willemwillempackage Net::DNS::Update; # # $Id: Update.pm 1455 2016-02-15 15:51:21Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1455 $)[1]; =head1 NAME Net::DNS::Update - DNS dynamic update packet =head1 SYNOPSIS use Net::DNS; $update = new Net::DNS::Update( 'example.com', 'IN' ); $update->push( prereq => nxrrset('foo.example.com. A') ); $update->push( update => rr_add('foo.example.com. 86400 A 192.168.1.2') ); =head1 DESCRIPTION Net::DNS::Update is a subclass of Net::DNS::Packet, to be used for making DNS dynamic updates. Programmers should refer to RFC2136 for dynamic update semantics. =cut use strict; use base 'Net::DNS::Packet'; use Carp; =head1 METHODS =head2 new $update = new Net::DNS::Update; $update = new Net::DNS::Update( 'example.com' ); $update = new Net::DNS::Update( 'example.com', 'HS' ); Returns a Net::DNS::Update object suitable for performing a DNS dynamic update. Specifically, it creates a packet with the header opcode set to UPDATE and the zone record type to SOA (per RFC 2136, Section 2.3). Programs must use the push() method to add RRs to the prerequisite, update, and additional sections before performing the update. Arguments are the zone name and the class. The zone and class may be undefined or omitted and default to the default domain from the resolver configuration and IN respectively. =cut sub new { shift; my ( $zone, @class ) = @_; unless ( defined $zone ) { require Net::DNS::Resolver; ($zone) = new Net::DNS::Resolver()->domain; # default from resolver config } eval { local $SIG{__DIE__}; my $self = __PACKAGE__->SUPER::new( $zone, 'SOA', @class ); my $header = $self->header; $header->opcode('UPDATE'); $header->qr(0); $header->rd(0); return $self; } || croak $@; } =head2 push $ancount = $update->push( prereq => $rr ); $nscount = $update->push( update => $rr ); $arcount = $update->push( additional => $rr ); $nscount = $update->push( update => $rr1, $rr2, $rr3 ); $nscount = $update->push( update => @rr ); Adds RRs to the specified section of the update packet. Returns the number of resource records in the specified section. Section names may be abbreviated to the first three characters. =cut sub push { my $self = shift; my $list = $self->_section(shift); my @arg = grep ref($_), @_; my ($zone) = $self->zone; my $zclass = $zone->zclass; my @rr = grep $_->class( $_->class =~ /ANY|NONE/ ? () : $zclass ), @arg; CORE::push( @$list, @rr ); } =head2 unique_push $ancount = $update->unique_push( prereq => $rr ); $nscount = $update->unique_push( update => $rr ); $arcount = $update->unique_push( additional => $rr ); $nscount = $update->unique_push( update => $rr1, $rr2, $rr3 ); $nscount = $update->unique_push( update => @rr ); Adds RRs to the specified section of the update packet provided that the RRs are not already present in the same section. Returns the number of resource records in the specified section. Section names may be abbreviated to the first three characters. =cut sub unique_push { my $self = shift; my $list = $self->_section(shift); my @arg = grep ref($_), @_; my ($zone) = $self->zone; my $zclass = $zone->zclass; my @rr = grep $_->class( $_->class =~ /ANY|NONE/ ? () : $zclass ), @arg; my %unique = map { ( bless( {%$_, ttl => 0}, ref $_ )->canonical => $_ ) } @rr, @$list; scalar( @$list = values %unique ); } 1; __END__ =head1 EXAMPLES The first example below shows a complete program. Subsequent examples show only the creation of the update packet. Although the examples are presented using the string form of RRs, the corresponding ( name => value ) form may also be used. =head2 Add a new host #!/usr/bin/perl use Net::DNS; # Create the update packet. my $update = new Net::DNS::Update('example.com'); # Prerequisite is that no A records exist for the name. $update->push( pre => nxrrset('foo.example.com. A') ); # Add two A records for the name. $update->push( update => rr_add('foo.example.com. 86400 A 192.168.1.2') ); $update->push( update => rr_add('foo.example.com. 86400 A 172.16.3.4') ); # Send the update to the zone's primary master. my $resolver = new Net::DNS::Resolver; $resolver->nameservers('primary-master.example.com'); my $reply = $resolver->send($update); # Did it work? if ($reply) { if ( $reply->header->rcode eq 'NOERROR' ) { print "Update succeeded\n"; } else { print 'Update failed: ', $reply->header->rcode, "\n"; } } else { print 'Update failed: ', $resolver->errorstring, "\n"; } =head2 Add an MX record for a name that already exists my $update = new Net::DNS::Update('example.com'); $update->push( prereq => yxdomain('example.com') ); $update->push( update => rr_add('example.com MX 10 mailhost.example.com') ); =head2 Add a TXT record for a name that does not exist my $update = new Net::DNS::Update('example.com'); $update->push( prereq => nxdomain('info.example.com') ); $update->push( update => rr_add('info.example.com TXT "yabba dabba doo"') ); =head2 Delete all A records for a name my $update = new Net::DNS::Update('example.com'); $update->push( prereq => yxrrset('foo.example.com A') ); $update->push( update => rr_del('foo.example.com A') ); =head2 Delete all RRs for a name my $update = new Net::DNS::Update('example.com'); $update->push( prereq => yxdomain('byebye.example.com') ); $update->push( update => rr_del('byebye.example.com') ); =head2 Perform a DNS update signed using a BIND private key file my $update = new Net::DNS::Update('example.com'); $update->push( update => rr_add('foo.example.com A 10.1.2.3') ); $update->sign_tsig( "$dir/Khmac-sha512.example.com.+165+01018.private" ); my $reply = $resolver->send( $update ); $reply->verify( $update ) || die $reply->verifyerr; =head2 Signing the DNS update using a BIND public key file $update->sign_tsig( "$dir/Khmac-sha512.example.com.+165+01018.key" ); =head2 Signing the DNS update using a customised TSIG record $update->sign_tsig( "$dir/Khmac-sha512.example.com.+165+01018.private", fudge => 60 ); =head2 Another way to sign a DNS update my $key_name = 'tsig-key'; my $key = 'awwLOtRfpGE+rRKF2+DEiw=='; my $tsig = new Net::DNS::RR("$key_name TSIG $key"); $tsig->fudge(60); my $update = new Net::DNS::Update('example.com'); $update->push( update => rr_add('foo.example.com A 10.1.2.3') ); $update->push( additional => $tsig ); =head1 COPYRIGHT Copyright (c)1997-2000 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. Portions Copyright (c)2015 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, L, L, RFC 2136, RFC 2845 =cut Net-DNS-1.07/lib/Net/DNS/Packet.pm0000644000175000017500000005100313031240164015633 0ustar willemwillempackage Net::DNS::Packet; # # $Id: Packet.pm 1523 2016-12-29 16:53:52Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1523 $)[1]; =head1 NAME Net::DNS::Packet - DNS protocol packet =head1 SYNOPSIS use Net::DNS::Packet; $query = new Net::DNS::Packet( 'example.com', 'MX', 'IN' ); $reply = $resolver->send( $query ); =head1 DESCRIPTION A Net::DNS::Packet object represents a DNS protocol packet. =cut use strict; use integer; use Carp; use constant UDPSZ => 512; BEGIN { require Net::DNS::Header; require Net::DNS::Question; require Net::DNS::RR; } =head1 METHODS =head2 new $packet = new Net::DNS::Packet( 'example.com' ); $packet = new Net::DNS::Packet( 'example.com', 'MX', 'IN' ); $packet = new Net::DNS::Packet(); If passed a domain, type, and class, new() creates a Net::DNS::Packet object which is suitable for making a DNS query for the specified information. The type and class may be omitted; they default to A and IN. If called with an empty argument list, new() creates an empty packet. =cut sub new { return &decode if ref $_[1]; my $class = shift; my $self = bless { status => 0, question => [], answer => [], authority => [], additional => [], }, $class; $self->{question} = [Net::DNS::Question->new(@_)] if scalar @_; return $self; } #=head2 decode =pod $packet = new Net::DNS::Packet( \$data ); $packet = new Net::DNS::Packet( \$data, 1 ); # debug If passed a reference to a scalar containing DNS packet data, a new packet object is created by decoding the data. The optional second boolean argument enables debugging output. Returns undef if unable to create a packet object. Decoding errors, including data corruption and truncation, are collected in the $@ ($EVAL_ERROR) variable. ( $packet, $length ) = new Net::DNS::Packet( \$data ); If called in array context, returns a packet object and the number of octets successfully decoded. Note that the number of RRs in each section of the packet may differ from the corresponding header value if the data has been truncated or corrupted during transmission. =cut use constant HEADER_LENGTH => length pack 'n6', (0) x 6; sub decode { my $class = shift; # uncoverable pod my $data = shift; my $debug = shift || 0; my $offset = 0; my $self; eval { local $SIG{__DIE__}; die 'corrupt wire-format data' if length($$data) < HEADER_LENGTH; # header section my ( $id, $status, @count ) = unpack 'n6', $$data; my ( $qd, $an, $ns, $ar ) = @count; $offset = HEADER_LENGTH; $self = bless { id => $id, status => $status, count => [@count], question => [], answer => [], authority => [], additional => [], answersize => length $$data }, $class; # question/zone section my $hash = {}; my $record; while ( $qd-- ) { ( $record, $offset ) = decode Net::DNS::Question( $data, $offset, $hash ); CORE::push( @{$self->{question}}, $record ); } # RR sections while ( $an-- ) { ( $record, $offset ) = decode Net::DNS::RR( $data, $offset, $hash ); CORE::push( @{$self->{answer}}, $record ); } while ( $ns-- ) { ( $record, $offset ) = decode Net::DNS::RR( $data, $offset, $hash ); CORE::push( @{$self->{authority}}, $record ); } while ( $ar-- ) { ( $record, $offset ) = decode Net::DNS::RR( $data, $offset, $hash ); CORE::push( @{$self->{additional}}, $record ); } return $self; }; if ($debug) { local $@ = $@; print $@ if $@; $self->print if $self; } return wantarray ? ( $self, $offset ) : $self; } =head2 data $data = $packet->data; $data = $packet->data( $size ); Returns the packet data in binary format, suitable for sending as a query or update request to a nameserver. Truncation may be specified using a non-zero optional size argument. =cut sub data { &encode; } sub encode { my ( $self, $size ) = @_; # uncoverable pod my $edns = $self->edns; # EDNS support my @addl = grep !$_->isa('Net::DNS::RR::OPT'), @{$self->{additional}}; $self->{additional} = [@addl, $edns] if $edns->_specified; return $self->truncate($size) if $size; my @part = qw(question answer authority additional); my @size = map scalar( @{$self->{$_}} ), @part; my $data = pack 'n6', $self->header->id, $self->{status}, @size; $self->{count} = []; my $hash = {}; # packet body foreach my $component ( map @{$self->{$_}}, @part ) { $data .= $component->encode( length $data, $hash, $self ); } return $data; } =head2 header $header = $packet->header; Constructor method which returns a Net::DNS::Header object which represents the header section of the packet. =cut sub header { my $self = shift; bless \$self, q(Net::DNS::Header); } =head2 edns $edns = $packet->edns; $version = $edns->version; $UDPsize = $edns->size; Auxiliary function which provides access to the EDNS protocol extension OPT RR. =cut sub edns { my $self = shift; my $link = \$self->{xedns}; ($$link) = grep $_->isa(qw(Net::DNS::RR::OPT)), @{$self->{additional}} unless $$link; $$link = new Net::DNS::RR( type => 'OPT' ) unless $$link; return $$link; } =head2 reply $reply = $query->reply( $UDPmax ); Constructor method which returns a new reply packet. The optional UDPsize argument is the maximum UDP packet size which can be reassembled by the local network stack, and is advertised in response to an EDNS query. =cut sub reply { my $query = shift; my $UDPmax = shift; my $qheadr = $query->header; croak 'erroneous qr flag in query packet' if $qheadr->qr; my $reply = new Net::DNS::Packet(); my $header = $reply->header; $header->qr(1); # reply with same id, opcode and question $header->id( $qheadr->id ); $header->opcode( $qheadr->opcode ); my @question = $query->question; $reply->{question} = [@question]; $header->rcode('FORMERR'); # no RCODE considered sinful! $header->rd( $qheadr->rd ); # copy these flags into reply $header->cd( $qheadr->cd ); return $reply unless grep $_->isa('Net::DNS::RR::OPT'), @{$query->{additional}}; my $edns = $reply->edns(); CORE::push( @{$reply->{additional}}, $edns ); $edns->size($UDPmax); return $reply; } =head2 question, zone @question = $packet->question; Returns a list of Net::DNS::Question objects representing the question section of the packet. In dynamic update packets, this section is known as zone() and specifies the DNS zone to be updated. =cut sub question { my @qr = @{shift->{question}}; } sub zone {&question} =head2 answer, pre, prerequisite @answer = $packet->answer; Returns a list of Net::DNS::RR objects representing the answer section of the packet. In dynamic update packets, this section is known as pre() or prerequisite() and specifies the RRs or RRsets which must or must not preexist. =cut sub answer { my @rr = @{shift->{answer}}; } sub pre {&answer} sub prerequisite {&answer} =head2 authority, update @authority = $packet->authority; Returns a list of Net::DNS::RR objects representing the authority section of the packet. In dynamic update packets, this section is known as update() and specifies the RRs or RRsets to be added or deleted. =cut sub authority { my @rr = @{shift->{authority}}; } sub update {&authority} =head2 additional @additional = $packet->additional; Returns a list of Net::DNS::RR objects representing the additional section of the packet. =cut sub additional { my @rr = @{shift->{additional}}; } =head2 print $packet->print; Prints the packet data on the standard output in an ASCII format similar to that used in DNS zone files. =cut sub print { print &string; } =head2 string print $packet->string; Returns a string representation of the packet. =cut sub string { my $self = shift; my $header = $self->header; my $update = $header->opcode eq 'UPDATE'; my $server = $self->{answerfrom}; my $length = $self->{answersize}; my $string = $server ? ";; Answer received from $server ($length bytes)\n" : ""; $string .= ";; HEADER SECTION\n" . $header->string; my $question = $update ? 'ZONE' : 'QUESTION'; my @question = map $_->string, $self->question; my $qdcount = scalar @question; my $qds = $qdcount != 1 ? 's' : ''; $string .= join "\n;; ", "\n;; $question SECTION ($qdcount record$qds)", @question; my $answer = $update ? 'PREREQUISITE' : 'ANSWER'; my @answer = map $_->string, $self->answer; my $ancount = scalar @answer; my $ans = $ancount != 1 ? 's' : ''; $string .= join "\n", "\n\n;; $answer SECTION ($ancount record$ans)", @answer; my $authority = $update ? 'UPDATE' : 'AUTHORITY'; my @authority = map $_->string, $self->authority; my $nscount = scalar @authority; my $nss = $nscount != 1 ? 's' : ''; $string .= join "\n", "\n\n;; $authority SECTION ($nscount record$nss)", @authority; my @additional = map $_->string, $self->additional; my $arcount = scalar @additional; my $ars = $arcount != 1 ? 's' : ''; $string .= join "\n", "\n\n;; ADDITIONAL SECTION ($arcount record$ars)", @additional; return "$string\n\n"; } =head2 answerfrom print "packet received from ", $packet->answerfrom, "\n"; Returns the IP address from which this packet was received. User-created packets will return undef for this method. =cut sub answerfrom { my $self = shift; $self->{answerfrom} = shift if scalar @_; $self->{answerfrom}; } =head2 answersize print "packet size: ", $packet->answersize, " bytes\n"; Returns the size of the packet in bytes as it was received from a nameserver. User-created packets will return undef for this method (use length($packet->data) instead). =cut sub answersize { shift->{answersize}; } =head2 push $ancount = $packet->push( prereq => $rr ); $nscount = $packet->push( update => $rr ); $arcount = $packet->push( additional => $rr ); $nscount = $packet->push( update => $rr1, $rr2, $rr3 ); $nscount = $packet->push( update => @rr ); Adds RRs to the specified section of the packet. Returns the number of resource records in the specified section. Section names may be abbreviated to the first three characters. =cut sub push { my $self = shift; my $list = $self->_section(shift); CORE::push( @$list, grep ref($_), @_ ); } =head2 unique_push $ancount = $packet->unique_push( prereq => $rr ); $nscount = $packet->unique_push( update => $rr ); $arcount = $packet->unique_push( additional => $rr ); $nscount = $packet->unique_push( update => $rr1, $rr2, $rr3 ); $nscount = $packet->unique_push( update => @rr ); Adds RRs to the specified section of the packet provided that the RRs are not already present in the same section. Returns the number of resource records in the specified section. Section names may be abbreviated to the first three characters. =cut sub unique_push { my $self = shift; my $list = $self->_section(shift); my @rr = grep ref($_), @_; my %unique = map { ( bless( {%$_, ttl => 0}, ref $_ )->canonical => $_ ) } @rr, @$list; scalar( @$list = values %unique ); } =head2 pop my $rr = $packet->pop( 'pre' ); my $rr = $packet->pop( 'update' ); my $rr = $packet->pop( 'additional' ); Removes a single RR from the specified section of the packet. =cut sub pop { my $self = shift; my $list = $self->_section(shift); CORE::pop(@$list); } my %_section = ( ## section name abbreviation table 'ans' => 'answer', 'pre' => 'answer', 'aut' => 'authority', 'upd' => 'authority', 'add' => 'additional' ); sub _section { ## returns array reference for section my $self = shift; my $name = shift; my $list = $_section{unpack 'a3', $name} || $name; $self->{$list} ||= []; } =head2 sign_tsig $query = Net::DNS::Packet->new( 'www.example.com', 'A' ); $query->sign_tsig( 'Khmac-sha512.example.+165+01018.private', fudge => 60 ); $reply = $res->send( $query ); $reply->verify( $query ) || die $reply->verifyerr; Attaches a TSIG resource record object, which will be used to sign the packet (see RFC 2845). The TSIG record can be customised by optional additional arguments to sign_tsig() or by calling the appropriate Net::DNS::RR::TSIG methods. If you wish to create a TSIG record using a non-standard algorithm, you will have to create it yourself. In all cases, the TSIG name must uniquely identify the key shared between the parties, and the algorithm name must identify the signing function to be used with the specified key. $tsig = Net::DNS::RR->new( name => 'tsig.example', type => 'TSIG', algorithm => 'custom-algorithm', key => '', sig_function => sub { my ($key, $data) = @_; ... } ); $query->sign_tsig( $tsig ); The historical simplified syntax is still available, but additional options can not be specified. $packet->sign_tsig( $key_name, $key ); The response to an inbound request is signed by presenting the request in place of the key parameter. $response = $request->reply; $response->sign_tsig( $request, @options ); Multi-packet transactions are signed by chaining the sign_tsig() calls together as follows: $opaque = $packet1->sign_tsig( 'Kexample.+165+13281.private' ); $opaque = $packet2->sign_tsig( $opaque ); $packet3->sign_tsig( $opaque ); The opaque intermediate object references returned during multi-packet signing are not intended to be accessed by the end-user application. Any such access is expressly forbidden. Note that a TSIG record is added to every packet; this implementation does not support the suppressed signature scheme described in RFC2845. =cut sub sign_tsig { my $self = shift; eval { local $SIG{__DIE__}; require Net::DNS::RR::TSIG; my $tsig = Net::DNS::RR::TSIG->create(@_); $self->push( 'additional' => $tsig ); return $tsig; } || do { croak "$@\nTSIG: unable to sign packet"; }; } =head2 verify and verifyerr $packet->verify() || die $packet->verifyerr; $reply->verify( $query ) || die $reply->verifyerr; Verify TSIG signature of packet or reply to the corresponding query. $opaque = $packet1->verify( $query ) || die $packet1->verifyerr; $opaque = $packet2->verify( $opaque ); $verifed = $packet3->verify( $opaque ) || die $packet3->verifyerr; The opaque intermediate object references returned during multi-packet verify() will be undefined (Boolean false) if verification fails. Access to the object itself, if it exists, is expressly forbidden. Testing at every stage may be omitted, which results in a BADSIG error on the final packet in the absence of more specific information. =cut sub verify { my $self = shift; my $sig = $self->sigrr; return $sig ? $sig->verify( $self, @_ ) : shift; } sub verifyerr { my $self = shift; my $sig = $self->sigrr; return $sig ? $sig->vrfyerrstr : 'not signed'; } =head2 sign_sig0 SIG0 support is provided through the Net::DNS::RR::SIG class. The requisite cryptographic components are not integrated into Net::DNS but reside in the Net::DNS::SEC distribution available from CPAN. $update = new Net::DNS::Update('example.com'); $update->push( update => rr_add('foo.example.com A 10.1.2.3')); $update->sign_sig0('Kexample.com+003+25317.private'); Execution will be terminated if Net::DNS::SEC is not available. =head2 verify SIG0 $packet->verify( $keyrr ) || die $packet->verifyerr; $packet->verify( [$keyrr, ...] ) || die $packet->verifyerr; Verify SIG0 packet signature against one or more specified KEY RRs. =cut sub sign_sig0 { my $self = shift; my $karg = shift; eval { local $SIG{__DIE__}; require Net::DNS::RR::SIG; my $sig0; if ( ref($karg) eq 'Net::DNS::RR::SIG' ) { $sig0 = $karg; } else { $sig0 = Net::DNS::RR::SIG->create( '', $karg ); } $self->push( 'additional' => $sig0 ); return $sig0; } || do { croak "$@\nSIG0: unable to sign packet"; }; } =head2 sigrr $sigrr = $packet->sigrr() || die 'unsigned packet'; The sigrr method returns the signature RR from a signed packet or undefined if the signature is absent. =cut sub sigrr { my $self = shift; my ($sig) = reverse $self->additional; return undef unless $sig; return $sig if $sig->type eq 'TSIG'; return $sig if $sig->type eq 'SIG'; return undef; } ######################################## =head2 truncate The truncate method takes a maximum length as argument and then tries to truncate the packet and set the TC bit according to the rules of RFC2181 Section 9. The minimum maximum length that is honoured is 512 octets. =cut # From RFC2181: # # 9. The TC (truncated) header bit # # The TC bit should be set in responses only when an RRSet is required # as a part of the response, but could not be included in its entirety. # The TC bit should not be set merely because some extra information # could have been included, for which there was insufficient room. This # includes the results of additional section processing. In such cases # the entire RRSet that will not fit in the response should be omitted, # and the reply sent as is, with the TC bit clear. If the recipient of # the reply needs the omitted data, it can construct a query for that # data and send that separately. # # Where TC is set, the partial RRSet that would not completely fit may # be left in the response. When a DNS client receives a reply with TC # set, it should ignore that response, and query again, using a # mechanism, such as a TCP connection, that will permit larger replies. # Code developed from a contribution by Aaron Crane via rt.cpan.org 33547 sub truncate { my $self = shift; my $size = shift || UDPSZ; my $sigrr = $self->sigrr; $size = UDPSZ unless $size > UDPSZ; $size -= $sigrr->_size if $sigrr; my $data = pack 'x' x 12; # header placeholder my $hdsz = length $data; $self->{count} = []; my $tc; my $hash = {}; foreach my $section ( map $self->{$_}, qw(question answer authority) ) { my @list; foreach my $item (@$section) { my $component = $item->encode( length $data, $hash ); last if length($data) + length($component) > $size; last if $tc; $data .= $component; CORE::push @list, $item; } $tc++ if scalar(@list) < scalar(@$section); @$section = @list; } $self->header->tc(1) if $tc; # only set if truncated here my %rrset; my @order; foreach my $item ( grep ref($_) ne ref($sigrr), $self->additional ) { my $name = $item->{owner}->canonical; my $class = $item->{class} || 0; my $key = pack 'nna*', $class, $item->{type}, $name; CORE::push @order, $key unless $rrset{$key}; CORE::push @{$rrset{$key}}, $item; } my @list; foreach my $key (@order) { my $component = ''; my @item = @{$rrset{$key}}; foreach my $item (@item) { $component .= $item->encode( length $data, $hash ); } last if length($data) + length($component) > $size; $data .= $component; CORE::push @list, @item; } if ($sigrr) { $data .= $sigrr->encode( length $data, $hash, $self ); CORE::push @list, $sigrr; } $self->{'additional'} = \@list; my @part = qw(question answer authority additional); my @size = map scalar( @{$self->{$_}} ), @part; pack 'n6 a*', $self->header->id, $self->{status}, @size, substr( $data, $hdsz ); } ######################################## sub dump { ## print internal data structure require Data::Dumper; # uncoverable pod local $Data::Dumper::Maxdepth = $Data::Dumper::Maxdepth || 3; local $Data::Dumper::Sortkeys = $Data::Dumper::Sortkeys || 1; print Data::Dumper::Dumper(@_); } 1; __END__ =head1 COPYRIGHT Copyright (c)1997-2000 Michael Fuhr. Portions Copyright (c)2002-2004 Chris Reinhardt. Portions Copyright (c)2002-2009 Olaf Kolkman Portions Copyright (c)2007-2015 Dick Franks All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, L, L, L, RFC1035 Section 4.1, RFC2136 Section 2, RFC2845 =cut Net-DNS-1.07/lib/Net/DNS/Question.pm0000644000175000017500000002036113031240164016236 0ustar willemwillempackage Net::DNS::Question; # # $Id: Question.pm 1381 2015-08-25 07:36:09Z willem $ # use vars qw($VERSION); $VERSION = (qw$LastChangedRevision: 1381 $)[1]; =head1 NAME Net::DNS::Question - DNS question record =head1 SYNOPSIS use Net::DNS::Question; $question = new Net::DNS::Question('example.com', 'A', 'IN'); =head1 DESCRIPTION A Net::DNS::Question object represents a record in the question section of a DNS packet. =cut use strict; use integer; use Carp; use Net::DNS::Parameters; use Net::DNS::Domain; use Net::DNS::DomainName; =head1 METHODS =head2 new $question = new Net::DNS::Question('example.com', 'A', 'IN'); $question = new Net::DNS::Question('example.com'); $question = new Net::DNS::Question('192.0.32.10', 'PTR', 'IN'); $question = new Net::DNS::Question('192.0.32.10'); Creates a question object from the domain, type, and class passed as arguments. One or both type and class arguments may be omitted and will assume the default values shown above. RFC4291 and RFC4632 IP address/prefix notation is supported for queries in both in-addr.arpa and ip6.arpa namespaces. =cut sub new { my $self = bless {}, shift; my $qname = shift; my $qtype = shift || ''; my $qclass = shift || ''; # tolerate (possibly unknown) type and class in zone file order unless ( exists $classbyname{$qclass} ) { ( $qtype, $qclass ) = ( $qclass, $qtype ) if exists $classbyname{$qtype}; ( $qtype, $qclass ) = ( $qclass, $qtype ) if $qtype =~ /CLASS/; } unless ( exists $typebyname{$qtype} ) { ( $qtype, $qclass ) = ( $qclass, $qtype ) if exists $typebyname{$qclass}; ( $qtype, $qclass ) = ( $qclass, $qtype ) if $qclass =~ /TYPE/; } # if argument is an IP address, do appropriate reverse lookup if ( defined $qname and $qname =~ m/:|\d$/ ) { if ( my $reverse = _dns_addr($qname) ) { $qname = $reverse; $qtype ||= 'PTR'; } } $self->{qname} = new Net::DNS::DomainName1035($qname); $self->{qtype} = typebyname( $qtype || 'A' ); $self->{qclass} = classbyname( $qclass || 'IN' ); return $self; } =head2 decode $question = decode Net::DNS::Question(\$data, $offset); ($question, $offset) = decode Net::DNS::Question(\$data, $offset); Decodes the question record at the specified location within a DNS wire-format packet. The first argument is a reference to the buffer containing the packet data. The second argument is the offset of the start of the question record. Returns a Net::DNS::Question object and the offset of the next location in the packet. An exception is raised if the object cannot be created (e.g., corrupt or insufficient data). =cut use constant QFIXEDSZ => length pack 'n2', (0) x 2; sub decode { my $self = bless {}, shift; my ( $data, $offset ) = @_; ( $self->{qname}, $offset ) = decode Net::DNS::DomainName1035(@_); my $next = $offset + QFIXEDSZ; die 'corrupt wire-format data' if length $$data < $next; @{$self}{qw(qtype qclass)} = unpack "\@$offset n2", $$data; wantarray ? ( $self, $next ) : $self; } =head2 encode $data = $question->encode( $offset, $hash ); Returns the Net::DNS::Question in binary format suitable for inclusion in a DNS packet buffer. The optional arguments are the offset within the packet data where the Net::DNS::Question is to be stored and a reference to a hash table used to index compressed names within the packet. =cut sub encode { my $self = shift; pack 'a* n2', $self->{qname}->encode(@_), @{$self}{qw(qtype qclass)}; } =head2 print $object->print; Prints the record to the standard output. Calls the string() method to get the string representation. =cut sub print { print shift->string, "\n"; } =head2 string print "string = ", $question->string, "\n"; Returns a string representation of the question record. =cut sub string { my $self = shift; join "\t", $self->{qname}->string, $self->qclass, $self->qtype; } =head2 name $name = $question->name; Internationalised domain name corresponding to the qname attribute. Decoding non-ASCII domain names is computationally expensive and undesirable for names which are likely to be used to construct further queries. When required to communicate with humans, the 'proper' domain name should be extracted from a query or reply packet. $query = new Net::DNS::Packet( $example, 'ANY' ); $reply = $resolver->send($query) or die; ($question) = $reply->question; $name = $question->name; =cut sub name { my $self = shift; croak 'immutable object: argument invalid' if scalar @_; $self->{qname}->xname; } =head2 qname, zname $qname = $question->qname; $zname = $question->zname; Canonical ASCII domain name as required for the query subject transmitted to a nameserver. In dynamic update packets, this attribute is known as zname() and refers to the zone name. =cut sub qname { my $self = shift; croak 'immutable object: argument invalid' if scalar @_; $self->{qname}->name; } sub zname { &qname; } =head2 qtype, ztype, type $qtype = $question->type; $qtype = $question->qtype; $ztype = $question->ztype; Returns the question type attribute. In dynamic update packets, this attribute is known as ztype() and refers to the zone type. =cut sub type { my $self = shift; croak 'immutable object: argument invalid' if scalar @_; typebyval( $self->{qtype} ); } sub qtype { &type; } sub ztype { &type; } =head2 qclass, zclass, class $qclass = $question->class; $qclass = $question->qclass; $zclass = $question->zclass; Returns the question class attribute. In dynamic update packets, this attribute is known as zclass() and refers to the zone class. =cut sub class { my $self = shift; croak 'immutable object: argument invalid' if scalar @_; classbyval( $self->{qclass} ); } sub qclass { &class; } sub zclass { &class; } ######################################## sub _dns_addr { ## Map IP address into reverse lookup namespace local $_ = shift; # IP address must contain address characters only s/[%].+$//; # discard RFC4007 scopeid return undef unless m#^[a-fA-F0-9:./]+$#; my ( $address, $pfxlen ) = split m#/#; # map IPv4 address to in-addr.arpa space if (m#^\d*[.\d]*\d(/\d+)?$#) { my @parse = split /\./, $address; $pfxlen = scalar(@parse) << 3 unless $pfxlen; my $last = $pfxlen > 24 ? 3 : ( $pfxlen - 1 ) >> 3; return join '.', reverse( ( @parse, (0) x 3 )[0 .. $last] ), 'in-addr.arpa.'; } # map IPv6 address to ip6.arpa space return unless m#^[:\w]+:([.\w]*)(/\d+)?$#; my $rhs = $1 || '0'; return _dns_addr($rhs) if m#^[:0]*:0*:[fF]{4}:[^:]+$#; # IPv4 $rhs = sprintf '%x%0.2x:%x%0.2x', split( /\./, $rhs ), 0, 0, 0 if /\./; $address =~ s/:[^:]*$/:0$rhs/; my @parse = split /:/, ( reverse "0$address" ), 9; my @xpand = map { /./ ? $_ : ('0') x ( 9 - @parse ) } @parse; # expand :: $pfxlen = ( scalar(@xpand) << 4 ) unless $pfxlen; # implicit length if unspecified my $len = $pfxlen > 124 ? 32 : ( $pfxlen + 3 ) >> 2; my $hex = pack 'A4' x 8, map { $_ . '000' } ('0') x ( 8 - @xpand ), @xpand; return join '.', split( //, substr( $hex, -$len ) ), 'ip6.arpa.'; } 1; __END__ ######################################## =head1 COPYRIGHT Copyright (c)1997-2000 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. Portions Copyright (c)2003,2006-2011 Dick Franks. All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L, L, L, L, RFC 1035 Section 4.1.2 =cut Net-DNS-1.07/lib/Net/DNS.pm0000644000175000017500000003631113031240164014431 0ustar willemwillempackage Net::DNS; # # $Id: DNS.pm 1524 2016-12-29 16:54:37Z willem $ # BEGIN { require 5.004_04; require vars; 'vars'->import(qw($VERSION $SVNVERSION)); $VERSION = '1.07'; $VERSION = eval $VERSION; $SVNVERSION = (qw$LastChangedRevision: 1524 $)[1]; } =head1 NAME Net::DNS - Perl Interface to the Domain Name System =head1 SYNOPSIS use Net::DNS; =head1 DESCRIPTION Net::DNS is a collection of Perl modules that act as a Domain Name System (DNS) resolver. It allows the programmer to perform DNS queries that are beyond the capabilities of "gethostbyname" and "gethostbyaddr". The programmer should be somewhat familiar with the format of a DNS packet and its various sections. See RFC 1035 or DNS and BIND (Albitz & Liu) for details. =cut use strict; use integer; use base qw(Exporter); use vars qw(@EXPORT); @EXPORT = qw(SEQUENTIAL UNIXTIME YYYYMMDDxx yxrrset nxrrset yxdomain nxdomain rr_add rr_del mx rr rrsort); local $SIG{__DIE__}; require Net::DNS::RR; require Net::DNS::Packet; require Net::DNS::Update; require Net::DNS::Resolver; sub version { $VERSION; } # # rr() # # Usage: # @rr = rr('example.com'); # @rr = rr('example.com', 'A', 'IN'); # @rr = rr($res, 'example.com' ... ); # sub rr { my ($arg1) = @_; my $res = ref($arg1) ? shift : new Net::DNS::Resolver(); my $ans = $res->query(@_); my @list = $ans ? $ans->answer : (); } # # mx() # # Usage: # @mx = mx('example.com'); # @mx = mx($res, 'example.com'); # sub mx { my ($arg1) = @_; my @res = ( ref($arg1) ? shift : () ); my ( $name, @class ) = @_; # This construct is best read backwards. # # First we take the answer section of the packet. # Then we take just the MX records from that list # Then we sort the list by preference # We do this into an array to force list context. # Then we return the list. my @list = sort { $a->preference <=> $b->preference } grep $_->type eq 'MX', &rr( @res, $name, 'MX', @class ); return @list; } # # rrsort() # # Usage: # @prioritysorted = rrsort( "SRV", "priority", @rr_array ); # sub rrsort { my $rrtype = uc shift; my ( $attribute, @rr ) = @_; ## NB: attribute is optional ( @rr, $attribute ) = @_ if ref($attribute) =~ /^Net::DNS::RR/; my @extracted = grep $_->type eq $rrtype, @rr; return @extracted unless scalar @extracted; my $func = "Net::DNS::RR::$rrtype"->get_rrsort_func($attribute); my @sorted = sort $func @extracted; } # # Auxiliary functions to support policy-driven zone serial numbering. # # $successor = $soa->serial(SEQUENTIAL); # $successor = $soa->serial(UNIXTIME); # $successor = $soa->serial(YYYYMMDDxx); # sub SEQUENTIAL {undef} sub UNIXTIME { return CORE::time; } sub YYYYMMDDxx { my ( $dd, $mm, $yy ) = (localtime)[3 .. 5]; return 1900010000 + sprintf '%d%0.2d%0.2d00', $yy, $mm, $dd; } # # Auxiliary functions to support dynamic update. # sub yxrrset { my $rr = new Net::DNS::RR(@_); $rr->ttl(0); $rr->class('ANY') unless $rr->rdata; return $rr; } sub nxrrset { my $rr = new Net::DNS::RR(@_); new Net::DNS::RR( name => $rr->name, type => $rr->type, class => 'NONE' ); } sub yxdomain { my ( $domain, @etc ) = map split, @_; my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain ) ); new Net::DNS::RR( name => $rr->name, type => 'ANY', class => 'ANY' ); } sub nxdomain { my ( $domain, @etc ) = map split, @_; my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain ) ); new Net::DNS::RR( name => $rr->name, type => 'ANY', class => 'NONE' ); } sub rr_add { my $rr = new Net::DNS::RR(@_); $rr->{ttl} = 86400 unless defined $rr->{ttl}; return $rr; } sub rr_del { my ( $domain, @etc ) = map split, @_; my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain ) ); $rr->class( $rr->rdata ? 'NONE' : 'ANY' ); $rr->ttl(0); return $rr; } 1; __END__ =head2 Resolver Objects A resolver object is an instance of the L class. A program can have multiple resolver objects, each maintaining its own state information such as the nameservers to be queried, whether recursion is desired, etc. =head2 Packet Objects L queries return L objects. Packet objects have five sections: =over 3 =item * The header section, a L object. =item * The question section, a list of L objects. =item * The answer section, a list of L objects. =item * The authority section, a list of L objects. =item * The additional section, a list of L objects. =back =head2 Update Objects L is a subclass of L used to create dynamic update requests. =head2 Header Objects L objects represent the header section of a DNS packet. =head2 Question Objects L objects represent the content of the question section of a DNS packet. =head2 RR Objects L is the base class for DNS resource record (RR) objects in the answer, authority, and additional sections of a DNS packet. Do not assume that RR objects will be of the type requested. The type of an RR object must be checked before calling any methods. =head1 METHODS See the manual pages listed above for other class-specific methods. =head2 version print Net::DNS->version, "\n"; Returns the version of Net::DNS. =head2 rr # Use a default resolver -- can not get an error string this way. use Net::DNS; my @rr = rr("example.com"); my @rr = rr("example.com", "A"); my @rr = rr("example.com", "A", "IN"); # Use your own resolver object. my $res = Net::DNS::Resolver->new; my @rr = rr($res, "example.com" ... ); my ($ptr) = rr("192.0.2.1"); The rr() method provides simple RR lookup for scenarios where the full flexibility of Net::DNS is not required. Returns a list of L objects for the specified name or an empty list if the query failed or no record was found. See L for more complete examples. =head2 mx # Use a default resolver -- can not get an error string this way. use Net::DNS; my @mx = mx("example.com"); # Use your own resolver object. my $res = Net::DNS::Resolver->new; my @mx = mx($res, "example.com"); Returns a list of L objects representing the MX records for the specified name. The list will be sorted by preference. Returns an empty list if the query failed or no MX record was found. This method does not look up A records; it only performs MX queries. =head1 Dynamic DNS Update Support The Net::DNS module provides auxiliary functions which support dynamic DNS update requests. =head2 yxrrset Use this method to add an "RRset exists" prerequisite to a dynamic update packet. There are two forms, value-independent and value-dependent: # RRset exists (value-independent) $update->push(pre => yxrrset("host.example.com A")); Meaning: At least one RR with the specified name and type must exist. # RRset exists (value-dependent) $update->push(pre => yxrrset("host.example.com A 10.1.2.3")); Meaning: At least one RR with the specified name and type must exist and must have matching data. Returns a L object or C if the object could not be created. =head2 nxrrset Use this method to add an "RRset does not exist" prerequisite to a dynamic update packet. $update->push(pre => nxrrset("host.example.com A")); Meaning: No RRs with the specified name and type can exist. Returns a L object or C if the object could not be created. =head2 yxdomain Use this method to add a "name is in use" prerequisite to a dynamic update packet. $update->push(pre => yxdomain("host.example.com")); Meaning: At least one RR with the specified name must exist. Returns a L object or C if the object could not be created. =head2 nxdomain Use this method to add a "name is not in use" prerequisite to a dynamic update packet. $update->push(pre => nxdomain("host.example.com")); Meaning: No RR with the specified name can exist. Returns a L object or C if the object could not be created. =head2 rr_add Use this method to add RRs to a zone. $update->push(update => rr_add("host.example.com A 10.1.2.3")); Meaning: Add this RR to the zone. RR objects created by this method should be added to the "update" section of a dynamic update packet. The TTL defaults to 86400 seconds (24 hours) if not specified. Returns a L object or C if the object could not be created. =head2 rr_del Use this method to delete RRs from a zone. There are three forms: delete all RRsets, delete an RRset, and delete a specific RR. # Delete all RRsets. $update->push(update => rr_del("host.example.com")); Meaning: Delete all RRs having the specified name. # Delete an RRset. $update->push(update => rr_del("host.example.com A")); Meaning: Delete all RRs having the specified name and type. # Delete a specific RR. $update->push(update => rr_del("host.example.com A 10.1.2.3")); Meaning: Delete all RRs having the specified name, type, and data. RR objects created by this method should be added to the "update" section of a dynamic update packet. Returns a L object or C if the object could not be created. =head1 Zone Serial Number Management The Net::DNS module provides auxiliary functions which support policy-driven zone serial numbering regimes. =head2 SEQUENTIAL $successor = $soa->serial( SEQUENTIAL ); The existing serial number is incremented modulo 2**32. =head2 UNIXTIME $successor = $soa->serial( UNIXTIME ); The Unix time scale will be used as the basis for zone serial numbering. The serial number will be incremented if the time elapsed since the previous update is less than one second. =head2 YYYYMMDDxx $successor = $soa->serial( YYYYMMDDxx ); The 32 bit value returned by the auxiliary YYYYMMDDxx() function will be used as the base for the date-coded zone serial number. Serial number increments must be limited to 100 per day for the date information to remain useful. =head1 Sorting of RR arrays rrsort() provides functionality to help you sort RR arrays. In most cases rrsort() will give you the answer that you want, but you can specify your own sorting method by using the Net::DNS::RR::FOO->set_rrsort_func() class method. See Net::DNS::RR for details. =head2 rrsort() use Net::DNS; my @sorted = rrsort( $rrtype, $attribute, @rr_array ); rrsort() selects all RRs from the input array that are of the type defined by the first argument. Those RRs are sorted based on the attribute that is specified as second argument. There are a number of RRs for which the sorting function is defined in the code. For instance: my @prioritysorted = rrsort( "SRV", "priority", @rr_array ); returns the SRV records sorted from lowest to highest priority and for equal priorities from highest to lowest weight. If the function does not exist then a numerical sort on the attribute value is performed. my @portsorted = rrsort( "SRV", "port", @rr_array ); If the attribute is not defined then either the default_sort() function or "canonical sorting" (as defined by DNSSEC) will be used. rrsort() returns a sorted array containing only elements of the specified RR type. Any other RR types are silently discarded. rrsort() returns an empty list when arguments are incorrect. =head1 EXAMPLES The following brief examples illustrate some of the features of Net::DNS. The documentation for individual modules and the demo scripts included with the distribution provide more extensive examples. See L for an example of performing dynamic updates. =head2 Look up host addresses. use Net::DNS; my $res = Net::DNS::Resolver->new; my $reply = $res->search("host.example.com"); if ($reply) { foreach my $rr ($reply->answer) { print $rr->address, "\n" if $rr->type eq "A"; } } else { warn "query failed: ", $res->errorstring, "\n"; } =head2 Find the nameservers for a domain. use Net::DNS; my $res = Net::DNS::Resolver->new; my $reply = $res->query("example.com", "NS"); if ($reply) { foreach $rr (grep { $_->type eq 'NS' } $reply->answer) { print $rr->nsdname, "\n"; } } else { warn "query failed: ", $res->errorstring, "\n"; } =head2 Find the MX records for a domain. use Net::DNS; my $name = "example.com"; my $res = Net::DNS::Resolver->new; my @mx = mx($res, $name); if (@mx) { foreach $rr (@mx) { print $rr->preference, " ", $rr->exchange, "\n"; } } else { warn "Can not find MX records for $name: ", $res->errorstring, "\n"; } =head2 Print domain SOA record in zone file format. use Net::DNS; my $res = Net::DNS::Resolver->new; my $reply = $res->query("example.com", "SOA"); if ($reply) { ($reply->answer)[0]->print; } else { print "query failed: ", $res->errorstring, "\n"; } =head2 Perform a zone transfer and print all the records. use Net::DNS; my $res = Net::DNS::Resolver->new; $res->nameservers("ns.example.com"); my @zone = $res->axfr("example.com"); foreach $rr (@zone) { $rr->print; } =head2 Perform a background query and print the reply. use Net::DNS; my $res = Net::DNS::Resolver->new; my $socket = $res->bgsend("host.example.com"); while ( $res->bgbusy($socket) ) { # do some work here while waiting for the answer # ...and some more here } my $packet = $res->bgread($socket); $packet->print; =head1 BUGS C is slow. For other items to be fixed, or if you discover a bug in this distribution please use the CPAN bug reporting system. =head1 COPYRIGHT Copyright (c)1997-2000 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. Portions Copyright (c)2005 Olaf Kolkman (RIPE NCC) Portions Copyright (c)2006 Olaf Kolkman (NLnet Labs) Portions Copyright (c)2014 Dick Franks All rights reserved. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 AUTHOR INFORMATION Net::DNS is maintained at NLnet Labs (www.nlnetlabs.nl) by Willem Toorop. Between 2005 and 2012 Net::DNS was maintained by Olaf Kolkman. Between 2002 and 2004 Net::DNS was maintained by Chris Reinhardt. Net::DNS was created in 1997 by Michael Fuhr. =head1 SEE ALSO L, L, L, L, L, L, RFC1035, L, I by Paul Albitz & Cricket Liu =cut Net-DNS-1.07/Changes0000644000175000017500000020665413031240164013457 0ustar willemwillem$Id: Changes 1523 2016-12-29 16:53:52Z willem $ -*-text-*- **** 1.07 December 29, 2016 Fix rt.cpan.org #118598/#108908 Serious Makefile.PL issues "make install" now suppressed if pre-1.01 version detected Fix rt.cpan.org #115558 Net::DNS::Nameserver does not allow EDNS replies Fix rt.cpan.org #114917 Net::DNS::ZoneFile fails to parse mixed case mnemonics Fix rt.cpan.org #114876 Use of uninitialized value in lc at MSWin32.pm line 77 Fix rt.cpan.org #114819 Net::DNS fails to compile with taint checks enabled **** 1.06 May 27, 2016 Fix rt.cpan.org #114918 Net::DNS::ZoneFile fails when unnamed RR follows $ORIGIN Fix rt.cpan.org #114351 Case sensitive compression breaks resolver->nameservers() Fix rt.cpan.org #113579 Net::DNS::Resolver dies on scoped IPv6 nameserver address Fix rt.cpan.org #113020 Resolve::Recurse Hangs Fix rt.cpan.org #112860 improperly terminated AXFR at t/08-IPv4.t line 446. **** 1.05 March 7, 2016 Fix rt.cpan.org #111559 1.04: TSIG not working anymore (TSIG.pm) Fix rt.cpan.org #108908 Installing recent version gets shadowed by old version. Warnings added to Makefile.PL and t/00-version.t. Fix rt.cpan.org #66900 Net::DNS::Async unable to retry truncated UDP using TCP because of limitations in Net::DNS. **** 1.04 December 8, 2015 Fix rt.cpan.org #109183 Semantics of "retry" and "retrans" options has changed with 1.03 Fix rt.cpan.org #109152 Deprecated method make_query_packet breaks calling code Fix rt.cpan.org #109135 Resolver behaves differently with long and short IPv6 address format Fix rt.cpan.org #108745 Net::DNS::Resolver bgsend **** 1.03 November 6, 2015 Fix rt.cpan.org #107897 t/10-recurse.t freezes, never completes Fix rt.cpan.org #101978 Update Net::DNS to use IO::Socket::IP Fix rt.cpan.org #84375 Timeout doesn't work with bgsend/bgread Fix rt.cpan.org #47050 persistent sockets for Resolver::bg(send|read|isready) Fix rt.cpan.org #15515 bgsend on TCP **** 1.02 September 16, 2015 Fix rt.cpan.org #107052 suppress messages: Can't locate Net/DNS/Resolver/linux.pm Fix rt.cpan.org #106916 Dependency on MIME::Base32 makes Net::DNS not installable on MSWin32 Fix rt.cpan.org #106565 Net::DNS::Resolver::Recurse and IPv6 Reverse DNS Fix rt.cpan.org #105808 Version test for Pod::Test is broken **** 1.01 Jul 6, 2015 Feature The RRs previously only available with Net::DNS::SEC are now integrated with Net::DNS. Net::DNS::SEC needs to be installed to enable the signature generation and verification functions. Fix rt.cpan.org #105491 Can't call method "zclass" on an undefined value at ... Net/DNS/Packet.pm line 474 Fix rt.cpan.org #105421 Dead link in Net::DNS::FAQ Fix rt.cpan.org #104657 Wrong split on Cygwin Fix rt.cpan.org #102810 Dynamic update: rr_add overrides ttl of zero Fix rt.cpan.org #102809 CAA broken **** 0.83 Feb 26, 2015 Fix rt.cpan.org #101798 AUTOLOAD error confusing w/o reference to object class Fix rt.cpan.org #101709 Provide separate control of IPv6 tests Fix rt.cpan.org #101675 MX record with 0 preference fails to parse Fix rt.cpan.org #101405 Install tests fail for v0.81 on Perl 5.21.7 **** 0.82 Jan 20, 2015 Fix rt.cpan.org #100385 Support for IPv6 link-local addresses with scope_id **** 0.81 Oct 29, 2014 Fix rt.cpan.org #99571 AXFR BADSIG failures Fix rt.cpan.org #99531 Resolver doc error - when is a 'bug' a 'bug'? [TSIG verification] Fix rt.cpan.org #99528 TSIG::create fails with some filenames Fix rt.cpan.org #99527 Random errors... [declaration with statement modifier] Fix rt.cpan.org #99429 Infinite recursion in Net::DNS::Resolver::Recurse::send when following certain delegations with empty non-terminals. Fix rt.cpan.org #99320 Net::DNS::ZoneFile bug in "$ORIGIN ." **** 0.80 Sep 22, 2014 Removal of Win32::IPHelper support with cygwin Resolvers on Cygwin can get their DNS configuration from the registry directly via the /proc filesystem. Getting rid of the other method reduces dependencies and makes installations less error prone. Rework rt.cpan.org #96119 "Too late to run INIT block" warning for require Net::DNS **** 0.79 Aug 22, 2014 Feature rt.cpan.org #98149 Add support for Android platform. Fix rt.cpan.org #97736 Net::DNS::Resolver->new mistakenly copies supplied arguments into default configuration on first instantiation. Fix rt.cpan.org #97502 Net::DNS::Resolver->retrans does not accept a value of 1 (uses 2 instead) Fix rt.cpan.org #83642 Configure CD flag in Net::DNS::Resolver->new Fix rt.cpan.org #81760 Reverted workaround for TXT issue preventing propagation of rule updates for SpamAssassin versions earlier than 3.4.0 Fix rt.cpan.org #16630 Net::DNS::Resolver::Recurse issues lots of IMHO unnecessary DNS requests. **** 0.78 Jul 10, 2014 Fix rt.cpan.org #97036 Nameserver identification on Cygwin Fix rt.cpan.org #96814 Trailing comments not stripped in /etc/resolv.conf Fix rt.cpan.org #96812 Net::DNS::Resolver->new() hangs if nameserver :: exists Fix rt.cpan.org #96755 RFC 3597 (hex) parsing mistake Fix rt.cpan.org #96708 String treated as boolean in TXT Fix rt.cpan.org #96608 "Insecure dependency in connect" with Net::DNS::Resolver over TCP Fix rt.cpan.org #96535 Net::DNS::Resolver warns "Use of uninitialized value in length" Fix rt.cpan.org #96531 Calling $resolver->nameservers multiple times returns an increasingly-long list (on some perl installations) Fix rt.cpan.org #96439 Uninitialised decoding object when printing packet **** 0.77 Jun 13, 2014 Fix rt.cpan.org #96151 Unlocalised $_ modified when reading config file Fix rt.cpan.org #96135 Deep recursion problem on Cygwin Fix rt.cpan.org #96119 "Too late to run INIT block" warning for require Net::DNS Fix rt.cpan.org #96035 Insert missing plan 'no-plan' in 10-recurse.t Fix inefficient Net::DNS::SEC compatibility code **** 0.76 May 23, 2014 Fix rt.cpan.org #95738 Test failure with IPv6 address in resolver.conf but without prerequisite IO::Socket::INET6 package installed. Fix rt.cpan.org #95596 Incorrect parsing of nameserver lines in resolv.conf Feature rt.cpan.org #79568 Implement prefer_v6 resolver configuration attribute. Fix rt.cpan.org #67602 Set resolver configuration defaults at first instantiation instead of module load time. **** 0.75 May 8, 2014 Fix rt.cpan.org #94069 Compile-time constant in Domain.pm/Text.pm cannot be used to store pointer to encoding object when using perlcc compiler. Thanks are due to Reini Urban for testing the revised code. Fix rt.cpan.org #93764 Resolver gives unhelpful errorstring when attempting to use IPv6-only nameserver without INET6 and Socket6 installed. Fix rt.cpan.org #92626 Clarify documentation surrounding SRV RR sorting Feature Implement TSIG verified zone transfer. Fix rt.cpan.org #92433 & #91241 TSIG: implement sign/verify for multi-packet message. Fix rt.cpan.org #79569 Iterate nameservers in AXFR **** 0.74 Jan 16, 2014 Fix rt.cpan.org #91306 Nameserver crashes on malformed UDP query. Fix rt.cpan.org #91241 TSIG: Fix incorrectly generated %algbyval table. Feature Add CAA, EUI48 and EUI64 RR implementation. **** 0.73 Nov 29, 2013 Fix rt.cpan.org #88778 $update->unique_push() does not work as advertised. Fix rt.cpan.org #88744 Nameserver crashes on malformed TCP query. Fix rt.cpan.org #84601/#81942 Fix memory leak on packet cleanup. Indirect self-reference via header prevented garbage collector from deallocating packet. Feature rt.cpan.org #84468 TSIG: add support for HMAC-SHA1 .. HMAC-SHA512 Fix rt.cpan.org #84110 Incorrect parsing of PTR records in zonefile. Fix rt.cpan.org #83755 Erroneous attempt to invoke Net::LibIDN package in Domain.pm. Fix rt.cpan.org #83078 Can't locate Net/DNS/Resolver/linux.pm in @INC Conjecture: eval{ ... }; if ($@) { ... }; broken by threads. Fix rt.cpan.org #83075 ZoneFile.pm wrongly rejects $TTL 0 directive. Fix rt.cpan.org #82621 Error string empty after failed TCP query. Fix rt.cpan.org #82296 IPv6 with embedded IPv4 address not mapped to ip6.arpa. Fix rt.cpan.org #82294 Perl taint inadvertently removed in Domain and Text objects. Feature rt.cpan.org #53610 add TSIG validation support **** 0.72 Dec 28, 2012 Fix rt.cpan.org #82148 nxrrset fails to ignore RDATA. Fix rt.cpan.org #82134 TSIG key and algorithm names not downcased in digest. Class not forced to ANY. Fix rt.cpan.org #82063 yxrrset, nxrrset and rr_del functions should force zero TTL. Fix rt.cpan.org #82047 Clarify documentation to indicate that header counts may differ from the number of RRs present if a packet is corrupt. Fix rt.cpan.org #81941 Clarify documentation to make users aware that bgread will not switch to TCP when a truncated packet is received. **** 0.71 Dec 15, 2012 Temporary workaround rt.cpan.org #81760 The rdatastr method for TXT RRs will return unconditionally quoted rdata fields to work around an issue with updating SpamAssassin rules. This workaround will be reverted after release of a version of SpamAssassin which resolves the issue. Fix TSIG initialization Uninitialised algorithm attribute caused signature generation to fail silently when creating a TSIG signed packet. Fix rt.cpan.org #81869 The rr_del auxilliary function broken by a conflicting change in the RR.pm string parser. Note the ambiguous use of ANY, which may stand for CLASS255 or TYPE255 depending upon the argument string presented. Fix rt.cpan.org #81756 Test failures on Perl 5.8.5 .. 5.8.8. lc(), uc() and case insensitive regex matching broken for UTF8. Thanks are due to Paul Howarth for patient work with perl -d. Fix rt.cpan.org #81787 NXDOMAIN no longer reported by $resolver->errorstring. Fix rt.cpan.org #81814 Allow zero in format, tag and algorithm fields of CERT RR. Fix rt.cpan.org #81786 Substitute last owner for leading spaces in multiline zonefile RR. Fix rt.cpan.org #77444 Make use of new extended header modus operandi for OPT records also in the resolver. Preventing a warning. **** 0.70 Dec 6, 2012 Feature Add support for NID L32 L64 LP, RFC6742. **** 0.69 Dec 5, 2012 Feature rt.cpan.org #62030 Parsing of BIND zone files implemented in Net::DNS::ZoneFile. This replaces and is backward compatible with the CPAN module of the same name. Enhancement to simplify RR subtype template and recode packages. Enhancement rt.cpan.org #75185 Packet decoder returns index to end of decoded data. Added packet->reply() method. Fix rt.cpan.org #79569 AXFR not setting packet->answer_from. Enhancement rt.cpan.org #18819 Added support for Unicode and non-ASCII character encoding. Feature integrate OPT as a header extension Treat extended rcodes and the DO flag like they are part of the packet header. Fix rt.cpan.org #77444 Support escaped characters according to RFC1035 in TXT rdata. Fix rt.cpan.org #77304 Fix resolver searchlist from registry setup on Win32. Enhancement rt.cpan.org #67570 Make wire2presentation two till eighteen times faster. A contribution from Matthew Horsfall Fix rt.cpan.org #73366 Remove existing TSIG when resigning with a new TSIG and give warning. Fix rt.cpan.org #75330 Also try nameserver without glue (as a last resort) when recursing. Fix rt.cpan.org #74493 Read correct resolver configuration in OS/2. **** 0.68 Jan 30, 2012 Fix rt.cpan.org #72314 Let a Net::DNS::Nameserver bind on Net::DNS::Nameserver::DEFAULT_ADDR as a last resort. Fix to suppress false warnings about subroutine profiles on ancient versions of perl. Fix to avoid constants with value undef which prevents unwanted code from being optimized away on ancient versions of perl. Fix code error in PTR.pm, canonical RDATA not downcased. Enhancement to clarify the function of parse and data methods, by renaming them to decode and encode respectively. Feature IDN query support. Question.pm modified to use the recently introduced DomainName.pm module to represent DNS names. Queries for domain names containing non-ASCII characters are now possible on Unicode platforms with CPAN Net::LibIDN installed. Introduction of Mailbox.pm module that will be used in the future to represent RDATA components containing DNS coded RFC822 mailbox addresses. Introduction of Text.pm module that will be used in the future to represent RDATA components containing text. **** 0.67 Nov 4, 2011 Enhancement rt.cpan.org #60726 On Cygwin Net::DNS now builds without Win32::IPHelper, unless a previous version is updated that did use it. The choice may also be set by the --iphelper or --noiphelper option to Makefile.PL. Fix to suppress IO::Socket::INET(6)::peerhost usage with TCP. On some systems it doesn't work after receiving data. Enhancement rt.cpan.org #43142 Allow ReplyHandlers to indicate that no answer should be returned by the Net::DNS::Nameserver. Fix rt.cpan.org #71796 Prevent TCP accepts from blocking on unfinished 3-way handshakes. Fix rt.cpan.org #65607 Make 64bits windows work by depending on Win32::IPHelper version 0.07 Thanks to Lian Wan Situ. Fix rt.cpan.org #66470 Named nameserver should be reachable by IPv6 too. Fix to make tests work in jailed environments where a reply might come from a different address than that of the loopback interface. Feature to use a class method ReplyHandler for classes inheriting from Net::DNS::Nameserver. A contribution from Rob Brown. Fix rt.cpan.org #71062 Replace the usage of the obsolete Win32::Registry module by Win32::TieRegistry module. Fix rt.cpan.org #68731 Fix linking of the C compiled parts of the library on Mac OS X New improved version of the check_soa script in the contrib section. A contribution from Dick Franks. Fix rt.cpan.org #70830 Make t/08-online.t handle NXDOMAIN hijacking that return more then one answer. Fix rt.cpan.org #24525 Removed dependency on Net::IP Fix online tests to use the library as documented and not use knowledge of the internal workings of the classes that should be hidden. A contribution from Dick Franks Fix rt.cpan.org #55682 Make online tests non-fatal by default. All interactive prompts are removed from Makefile.PL. Online tests may still be made a requisite by using the --online-tests option. Major rework of Net::DNS::Domain.pm and the addition of Net::DNS::DomainName.pm Which paves the way towards handling of character encodings and IDN. A contribution from Dick Franks. Fix rt.cpan.org #69174 Typo that prevented TCP traffic from being replied from the same socket as it was received on. Fix rt.cpan.org #68338 Suppress warnings of the deprecated use of qw as parentheses in perl 5.14. Enhancement rt.cpan.org #67418 A contribution from Wolfsage to perform presentation to wire format conversion more efficiently. Fix rt.cpan.org #67133 Gracefully handle corrupted incoming packets in Net::DNS::Nameserver. Feature to manage serial numbers in SOA records in a modular and extensible way. Three modules are provided. Strictly sequential, Date Encoded and Time Encoded. A contribution from Dick Franks. Fix rt.cpan.org #53325 Make Net::DNS::Resolver load even if /etc/resolv.conf is unreadable. Fix rt.cpan.org #63486 Make t/08-online.t fail gracefully in stead of crash on failures. Fix rt.cpan.org #55586 Various typo fixes. Fix rt.cpan.org #55682 Really do not use networking functions when online tests are disabled. Fix rt.cpan.org #64562 Replace TSIG key with the signature of the whole packet when signing a packet, even when the TSIG key is not the first in the additional section. Fix rt.cpan.org #56181 and #47265 Assembly of segmented TCP traffic. Feature rt.cpan.org #57289 Provide a configurable IdleTimeout for Net::DNS::Namserver. Fix rt.cpan.org #53595 Fix documentation to reflect code behaviour where on successful packet creation, the error should be ignored. Fix rt.cpan.org #58914 Fix spelling of "algorithm" Fix rt.cpan.org #61725 Include default domain in the search list on Win32. Thanks Mark Rallen. Fix rt.cpan.org #63321 A Net::DNS::Nameserver without a NotifyHandler now responds NOTIMP to NOTIFY requests. Fix rt.cpan.org #53595 Documentation now reflects Net::DNS::Packet construction behaviour. **** 0.66 Dec 30, 2009 Feature Truncation for Nameserver fixes rt.cpan.org #33547 and #42744 TAKE CARE: this feature may cause unexpected behavior for your nameservers and can be turned off by setting Truncate to 0 during the creation of the nameserver. my $ns = Net::DNS::Nameserver->new( Truncate => 0, ); Net::DNS::Packet::truncate is a new method that is called from within Net::DNS::Nameserver that truncates a packet according to the rules of RFC2181 section 9. Acknowledgement Aaron Crane for an elegant test and for inspiration for a direction. Feature: Added Net::DNS::Domain Net::DNS::Domain is an attempt to introduce a consistent model for representation of RFC 1035 s. The class and its test script t/02-domain.t are included to be exposed to various architectures. The class and its methods may be subject to change, both in terms of naming and functionality. A contribution by Dick Franks Fix improved fuzzy matching of CLASS and TYPE in the Question constructor method. A contribution by Dick Franks. Fix rt.cpan.org #43770 Update->rr_del() was reported broken for AAAA after 0.65. The same bug also occurred in HINFO RR. Fix rt.cpan.org #43765 Code inconsistent with documentation for loop_once. Note: Keeping timeout undefined in loop_once will now block until something arrived on the socket. Fix rt.cpan.org #47050 Fixed logic error in bgsend socket acquisition code. Fix rt.cpan.org #47265 (partial) Frequently Net:DNS under Windows XP has a UDP problem which is caused by a buggy implementation of SOCKS under Windows. One liner added to not continue UDP processing when that happens. Feature KX RR Added support for the KX RR, RFC2230 The implementation is trivial since the KX inherits almost all of its functionality by inheritance from the MX RR. Fix NSAP RR string representation RFC1706 specifies the masterfile format to have a leading "0x" and optional dot. This was not how the RR was represented with the rdatastr method (and hence string and print). Fix rt.cpan.org #52307 AAAA v4compat parsing bug Acknowledgement: BLBLACK Fix AAAA dynamic update Dynamic update of AAAA caused FORMERR on the prerequisite caused by AAAA creating rdata even when an address was never specified. This fix may cause difference in behavior for people who expect a NULL address ("::") when creating a AAAA without an address specified. Feature HIP RR Added support for the HIP RR, RFC5205 perldoc Net::DNS::RR::HIP for more information. Feature DHCID RR Added rudimentary support for the DHCID RR. Fix rt.cpan.org #50883 This is basically #11931 but for cygwin. Codepath in Cygwin and Win32 are now the same. This adds a dependency in cygwin. Acknowledgements "mikaraento" Fix rt.cpan.org #45407 and #43190 Fixed escaping of semicolon. Note a change in behavior: For TXT and SPF the rdatastr method (and therefore the print, and string method) returns the escaped format while the chr_str_list method will return unescaped format. Fix rt.cpan.org #43393 Typo in 01-resolver.t Fix rt.cpan.org #43273 Added check for uninitialized opcode in headermask in Nameserver.pm Fix rt.cpan.org #46635 Minor documentation error in opt.pm Fix rt.cpan.org #51009 Fixed handling of empty string in Net::DNS::stripdot. Elegant one-liner supplied by JMEHNLE. Fix rt.cpan.org #49035 Comment parsing fixed: Semicolon in character string blocks (such as in TXT and NAPTR) were only recognized when escaped. Also fixed the NAPTR regular expression to not interpret "bla' 'foo" as two strings bla and foo, but as one: bla' 'foo Fix cd flag settings Resolver bug and fix reported by Jon Haidu. **** 0.65 January 26, 2009 Fix rt.cpan.org #41076 When the AAAA object was constructed with new_from_hash with an address containing the "::" shorthand notation normalization was not done properly. Fix rt.cpan.org #42375 Typo in Win32.pm Registry root. **** 0.64 December 30, 2008 Feature rt.cpan.org #36656 Added support for the APL record (RFC 3123) The module consists of a list of Address Prefix Item objects as defined in the Net::DNS::RR::APL::ApItem class. NOTE: Class and its interface may be subject to change. Fix rt.cpan.org #11931 Wrong nameserver list handling in Net::DNS::Resolver::Win32 The init method has been rewritten to be based on WIN32::IPhelper for the selection of the domain and the IP addresses. This is believed to be more portable than trying to fetch the data from the registry. We still trying to get the searchlist from the registry. WARNING: If you use Perl under WIN32 (eg ActivePerl or Strawberry Perl) then your module dependency graph has changed drastically Fix IPv6 modules When IO::Socket::INET6 was available but Socket6 was not the code would recurse to infinity. Fix rt.cpan.org #21757 and Feature: Connectivity during test Addition of --no-IPv6-tests and --IPv6-tests option in Makefile.PL. Note: This causes two questions to be asked when building the Makefile instead of one. Besides the test suites are constructed so that all the connectivity testing happen in 001-connectivity.t and nonavailability of connectivity over a certain transport is signaled over files t/online.disabled and t/IPv6.disabled respectively. Both files are removed by t/99-cleanup Fix rt.cpan.org #34511 Priming query logic contained unneeded recursion. Now also falls back to hardcoded hints if there are no nameservers whatsoever. Fix rt.cpan.org #38390 and 37089 Added CD and AD bit control to the resolver. The CD flag defaults to being unset and the AD flags is set by default whenever DNSSEC is available. Both flags default to unset in absence of DNSSEC. Fix rt.cpan.org #37282 Improved error reporting during client disconnect from the nameserver NOTE rt.cpan.org # 40249 Release 0.62 introduced a feature to parse data inside a packet only when needed. This can cause the following to happen: Exception: corrupt or incomplete data at /usr/lib/perl5/Net/DNS/RR.pm line 510. caught at -e line 1 This may happen when you have undefined your packet data before all the sections have been fully parsed. Such as in: $packet = Net::DNS::Packet->new(\$data); undef($data); The workaround is to force parsing by calling the methods that parse the data. e.g. $packet = Net::DNS::Packet->new(\$data); $packet->answer; $packet->additional; $packet->authority; undef ($data) Fix rt.cpan.org # 41076 and # 41071 Net::DNS::RR->new_from_hash function would not normalize the content of the data so that a method getting a string representation would get inconsistent results depending on whether a RR was created from a string of from a hash. Fix rt.cpan.org # 41296 Compression buggy for large packets. Fix by Kim Minh. Fix rt.cpan.org # 35752 Perl 5.10.0 gave a number of issues on several platforms, preferring XSLoader over Dynaloader seemed to fix those. Bug rt.cpan.org #34510 Buggy setting of "Recursion too deep, aborted" corrected. Feature (rt.cpan.org #39284) The ReplyHandler now also receives a variable with an anonymous hash with the connection details. Variables supplied to the Reply handler are: $qname, $qclass, $qtype, $peerhost, $query, $conn The hash referenced by $conn contains the following buckets: sockhost, sockport, peerhost, and peerport. Feature t/08-online.t and t/10-recurse.t In particular environments a query for a.t. will resolve and or middleboxes will replace DNS packet content for queries to the root. A bunch of test is skipped when this (broken) environment is detected. Feature/Bug rt.cpan.org #22019 The initial fix for rt 22019 was to strip a trailing dot from all attributes that were provided as argument for the Net::DNS::RR::new_from_hash function. We have introduced Net::DNS::stripdot, a function that will strip the dots of domain names, taking into account possible escapes (e.g. labels like foo\\\..). As a side effect the new_from_string method will now convert possible spaces that are not trapped by some of the new_from_string functions and convert them to \032 escapes. For information: The internal storage of domain names is using presentation format without trailing dots. Bug @EXPORT and @EXPORT_OK moved to a BEGIN block so that Net::DNS::SEC can make use of exported functions Feature/Bug The Notify handler introduced in 0.63 did not set the OPCODE on the reply appropriately. This has been solved generically by allowing the "Headermask" that is returned as 4th element by the reply or notify handler in the nameserver also allows for the opcode to be set. e.g. as in return ("NXDOMAIN",[],[],[],{ opcode => "NS_NOTIFY_OP" } ); *** 0.63, 8 Feb 2008 This version contains a Security Fix. Feature NotifyHandler in Nameserver The NotifyHandler is a new attribute to the nameserver used in the same way as the ReplyHandler except that it is executed when the opcode is NS_NOTIFY (RFC1996). It takes the same arguments as the reply handler (i.e. $qname, $qclass, $qtype, $peerhost, and $query). Corrections made in the documentation. Fix rt.cpan.org #32937: 5.11 introduces new warning on uc(undef) The patch supplied fixes for methods where undefined arguments were likely. For methods where undefined arguments don't make the warning will be printed. Fix rt.cpan.org #32147: Default LocalAddr broken in Net::DNS::Nameserver 0.62 Listen on the default address if LocalAddr not defined. Fix rt.cpan.org #30316 Security issue with Net::DNS Resolver. Net/DNS/RR/A.pm in Net::DNS 0.60 build 654 allows remote attackers to cause a denial of service (program "croak") via a crafted DNS response (http://nvd.nist.gov/nvd.cfm?cvename=CVE-2007-6341). Packet parsing routines are now enclosed in eval blocks to trap exception and avoid premature termination of user program. Bug: mbox-dname and txt-dname were not allowed to be empty in the RP RR. Fix by Peter Koch *** 0.62, 28 December 2007 Features: Move of some functionality out of the Packet to the Question and RR classes; parsing of elements in the packet is now performed by calling the appropriate subclasses. New methods were introduced: * Net::DNS::Packet->parse() * Net::DNS::RR->parse() * Net::DNS::Question->parse() The Packet class now defers parsing of authority/additional until their content is really needed. This should cause a bit of performance improvement. Dick Franks is acknowledged for this Good Work (TM). Added 20081216 see NOTE above under rt.cpan.org # 40249 Feature: the Net::DNS::Packet's answersize() method will from now on ignore its arguments and just return the size of the packet. Feature: The Net::DNS::RR->new() method used to call Net::DNS::RR->new_from_data() whenever called with the appropriate combination of arguments. That (undocumented) behavior has been deprecated. Use Net::DNS::RR->new_from_data() directly if you depended on that. Feature: Net::DNS::Packets unique_push now ignores the TTL in comparison of uniqueness, this is closer to the intent of RFC2181, but not yet fully compliant. Fix rt.cpan.org #29816 Acquiring the IP address for the Resolver under Cygwin is made more resilient. Fix rt.cpan.org #31425 Empty question section in Base.pm search method detected Fix rt.cpan.org #31042 Makefile corrected to add a library target. Fix rt.cpan.org #29818 10-recurse.t used to fail in very specific environment (where a query for qname="." and qtype="NS" would return with an empty additional section). Fixed by adding the hints explicitly; this also forces the tests to take place under the root served by a-m.root-servers.net Fix rt.cpan.org #29877 Made 00-version.t recognize a "GIT" environment. Fix rt.cpan.org #29878 SPF.pm did not evaluate as true. Thanks Bjorn Hansen. Fix rt.cpan.org #21398 answersize() and answerfrom() set for persistent sockets Fix rt.cpan.org #29883 Fix various tests only available through SVN, so they are more robust (Acknowledgements Bjoern Hansen) Fix rt.cpan.org #24343 Resolver's nameserver() method would do silly things with undefined arguments. Fix rt.cpan.org #29531 Nameserver.pm, Packet.pm and Question.pm modified to avoid erroneous PTR lookup in response to mischievous query packet containing an IP address. Fix rt.cpan.org #27970 better netdns.o Marek Rouchal provided two minor improvements for linking the C code snippets Fix rt.cpan 28345 A fix in Test::Simple revealed an off by 1 error in the testplan for 05-rr-rrsort.t. The fix is to remove a test, creating a dependency on Test::Simple 0.71 seemed overkill. *** 0.61, 1 August 2007 Fix rt.cpan.org #28106, 28198, and 28590 Modification of $_ in various places. Fix t/11-inet6 assumed lowercase domain names. *** 0.60 20 June 2007 Fix spelling mistakes in change log using interactive spell checker (aspell). Fix Two redundant calls of $self->rdatastr() in Net::DNS::RR::string(). Fix rt.cpan.org #27285 bis Unreleased 0.59_1 dn_expand_PP() has security flaw allowing access to arbitrary data using crafted packet with out of range compression pointer. Patch by Dick Franks based on 0.59 code. Fix rt.cpan.org #27391 dn_compress() produces corrupt packet for name containing empty label. Fix rt.cpan.org #26957 dn_compress() croaks for name having label which exceeds 63 characters. Patch by Dick Franks truncates offending label. Feature check_soa test of NCACHE TTL Dick Franks supplied an improved version of check_soa script which performs a direct test of NCACHE TTL by looking up non-existent name and reporting value if it exceeds 86400. Test is skipped unless minimumTTL is above same threshold. Recent BIND implementations impose a ceiling on NCACHE TTLs internally, so a large minimumTTL value is unlikely to have damaging consequences at many sites. Fix rt.cpan.org #27285 Break out of malformed packets with compression loops. Steffen Ullrich is acknowledged for patch and test code. Feature check_zone "alternate domain" and "exception file" flags Paul Archer supplied a patch for check_zone adding two new features. Feature Support for IPSECKEY RR Rudimentary IPSECKEY RR support added. Fix rt.cpan.org #25342 HINFO would only accept its data fields within quotes. That has now been fixed to adhere to by inheriting parsing functions from TXT. Fix rt.cpan.org #24631 / Feature IP address prefix notation Dick Franks supplied a cleaned up version of Question.pm. Revised code deals with incomplete IPv6 address bug and accepts RFC4291 address prefix notation. IPv4/prefix also supported for completeness. This involved a minor change to the API for reverse IP lookup. Changing qtype to PTR is now performed for A and AAAA only. This allows queries for NS and SOA records at interior nodes to be specified using the address prefix. Type ANY queries now also produce the expected result. Cleaned up TYPE/CLASS reversal code, exploiting fact that the intersection of the sets of class and type names contains only one member (ANY). Minor cleanup of remaining code. Fix rt.cpan.org #22019 Expunge trailing dots from RR->new_from_hash() FQDN arguments. Patch by Dick Franks. Fix Recursion and EDNS OPT record The Recursive resolver process would add an OPT-RR with each recursion which causes FORMERRs with a number of authoritative servers. Feature SSHFP warn instead of die We do not die if a not implemented fingerprint type value is read from the wire, instead we 'warn' and return undef. Feature NSEC3PARAM hook A hook to load NSEC3PARAM when available has been added. WARNING: Both NSEC3 and NSEC3PARAM are configured with their experimental type codes. Feature rt r24525 Net::DNS::Resolver depended on Net::IP (2268 Kb) which depends on heavy module Math::BigInt (1780 Kb). Valery Studennikov suggested to ship Net::DNS::Resolver::Base with its own copies of ip_is_ipv[4|6] and supplied a patch with those functions stripped from Net::IP. Note that the package still depends on Net::IP because Net::DNS::Nameserver and a few tests depend on it. Fix rt 22334 Fixed "perl Makefile.PL --xs" behavior, patch by Tamas Palfalvi Fix rt 21752 and 24042 Applied the patch supplied by Alexandr Ciornii to be able to compile on ActiveState perl . Slight modifications based on comments by nimnul Fix rt 23961 Randomized the ID on the queries. Thanks to "hjp" for reporting and suggesting a fix. The randomization of the src port is supposed to be handled by the setting the source port to "0" (default). Overriding the default or using persistent sockets may be problematic. Also see: http://www.potaroo.net/ietf/idref/draft-hubert-dns-anti-spoofing/ Fix Minor compile time warnings for netdns.c on Fedora Core. *** 0.59 September 18, 2006 Fix rt.cpan.org 20836, 20857, 20994, and 21402 These tickets all revolved around proper reverse mapping of IPv6 addresses. Acknowledgments to Dick Franks who has provided elegant solutions and cleaned a bit of code. Note that directly calling Question->new() without arguments will cause the qclass,qtype to be IN, A instead of ANY, ANY. Net::DNS::Resolver's search() method would always gracefully interpret a qname in the form of an IPv4 address. It would go out and do a PTR query in the reverse address tree. This behavior has also been applied to IPv6 addresses in their many shapes and forms. This change did two things, 1) root zone not implicitly added to search list when looking up short name, 2) default domain appended to short name if DEFNAMES and not DNSRCH. Fix rt.cpan.org 18113 Minor error due to unapplied part of patch fixed. Feature: Experimental NSEC3 hooks. Added hook for future support of (experimental) NSEC3 support (NSEC3 having an experimental type code). *** 0.58 July 4, 2006 Feature: hooks for DLV support in Net::DNS::SEC added hooks for DLV support which is/will be available in Net::DNS::SEC as of subversion version 592 (Tests are done against the subversion number, not against the perl release version) Net::DNS::SEC version 0.15 will have DLV support. Partly Fixed rt.cpan.org 18940 djhale noticed a number of error conditions under which the udp_connection in Nameserver dies. We now print a warning instead of dying. Fix rt.cpan.org 18958 Fixed typebyname croak for SIGZERO. Acknowledgments to djhale. Optimize rt.cpan.org 11931 Hanno Stock optimized the method to get the list of available interfaces in Win32. I have only done very rudimentary tests on my Windows XP system. Fix dependency on "CC" rt.cpan.org 19352 The Makefile.PL depended on availability of "cc" and would bail out on systems where gcc is exclusively available. Thanks to Rob Windsor for noticing and patching. Fix compressed dnames in NAPTR/SRV Clayton O'Neill noted that the the domain names in in the NAPTR and SRV RRs rdata were subject to name compression which is not conform the specs. Also see RFC 2782 and 2915. Fix rt.cpan.org 18897 Zero-length rdata in TXT fixed (Acknowledgments to Roy Arends) Fix rt.cpan.org 18785 SPF would not work unless the TXT RR was not loaded first. No wonder, SPF fully inherits TXT and loading of TXT.pm is therefore a prerequisite. Fix rt.cpan.org 18713 Net::DNS::Resolver now deals gracefully with persistent sockets that got disconnected. It will first try to connect again to the socket and if that fails it will try to connect to the next available nameserver. tcp_timeout() is the parameter that determines how long to wait during a reconnect. Fix rt.cpan.org 18268 Added reference to RFC in croak message for label length > 63 in dn_comp(). Fix rt.cpan.org 18113 The inet6 tests contained another bug when online-tests were disabled. Klaus Heinz discovered and provided a patch. *** 0.57 February 24, 2006 Fix rt.cpan.org 17783 The inet6 tests do not skip enough tests when ipv6 is not available. I did not catch this in my setup since IPv6 is available on all my machines. Since this breaks automatic CPAN installs a new release is reasonable. *** 0.56 February 20, 2006 Fix rt.cpan.org 17694 Net::DNS::typesbyval() now confesses on undefined args. Acknowledgments to Dean Serenevy. Feature Implemented SPF (typecode 99). The class completely inherits from Net::DNS::RR::TXT (the easiest RR to implement ever). Feature added rrsort() function. Feature was requested by Eric Hall in rt.cpan.org 13392 This was a little tricky as I think that the sort functions are in fact RR specific class attributes that should be accessed through class methods. This is difficult to implement. I do think I found a fairly clean manner. It does require a global variable in Net::DNS to store the functions and some trickery when the sorting functions are defined. See Net::DNS and Net::DNS::RR documentation for details. Defaults sorting functions are currently implemented in SRV: default sort: low priority to high priority and for same preference highest weight first. weight: sort all RRs based on weight, highest first priority: see default sort MX: default sort: lowest preference first. preference: see default sort NAPTR: default sort: lowest to highest order, for same order lowest preference first order: see default sort preference: order on preference, lowest first PX: See MX RT: See MX Fix rt.cpan.org 14653 and 14049 TCP fallback after V6 socket failure Reworked Net::DNS::Base::Nameserver::send_tcp() to fallback to IPv4 when possible. (change applied to SVN Revision 538). Feature Cleanup duplicated code axfr_send() and send_tcp() contained some duplicated code. I merged this in one "helper" method _create_tcp_socket() Fix AXFR persistent sockets colliding with query sockets. I think that using the same persistent sockets for AXFR and 'ordinary' queries could lead to race conditions. Better safe than sorry. For axfrs we create a different set of persistent sockets. Note that this prevents performing a SOA query first and then using the same socket for the zone transfer itself(in Net::DNS these are different code paths). This behavior of SOA and transfer on the same socket-- seems to be suggested by 1035 section 4.2.2: "In particular, the server should allow the SOA and AXFR request sequence (which begins a refresh operation) to be made on a single connection." Obviously, on the client side this behavior is not mandatory. Fix rt.cpan.org 17596 The fixes and features above also fixed the timeout problem reported by Paul Hofman Profiling It turned out that each time we were calling Net::DNS::Resolver::Base::nameserver(); We were creating a resolver object. Now a resolver object is only called when a domain name is given as argument. **** 0.55 December 14, 2005 Fix Inconsistency in test There was an inconsistency in the t/05-rr.t that got triggered by the release of Net::DNS::SEC version 0.13 (when installed). That has been fixed. Feature Net::DNS::Nameserver loop_once() Uncommented the documentation of the loop_once() function and introduced get_open_tcp() that reports if there are any open TCP sockets (useful when using loop_once(). loop_once() itself was introduced in version 0.53_02 Fix rt.cpan.org 16392 TCP Sockets stayed open even if not requested. This may cause the kernel to run out of TCP slots. This bug is the reason for releasing version 0.55 shortly after 0.54. Spotted and patched by Robert Felber. *** 0.54 December 7, 2005 Fix rt.cpan.org 15947 Failure to bind a nameserver when specifying an IPv6 address. Fix rt.cpan.org 11931 Using Net-DNS 0.53 on Win XP, it is unable to retrieve the nameservers when the IP address of the interface is assigned by DHCP. This is due to the DHCP assigned IP address being stored in DhcpIPAddress rather than IPAddress (which is then 0.0.0.0). Adding a check of DhcpIPAddress existence and not being 0.0.0.0 fixes the problem. Applied the patch submitted by "orjan". Fix rt.cpan.org 15119 main_loop() consumed 100% of CPU, because of a bug that caused loop_once() to loop ad infinitum. Fix rt.cpan.org 15299 Defining multiple constants with 'use constant { BLA => 1, FOO =>2 }; is a backwards incompatible feature. Thanks to Ian White for spotting and fixing this. *** 0.53_02 Oct 18, 2005 Fix rt.cpan.org 14046 RRSIGs verify and create failed for a number of RR types. The error message showed something like: Can't call method "dn_comp" on an undefined value This was caused by an omission in the _canonicalRdata() method in Net::DNS::RR that was inherited by all failing RR types. Code was added to t/05-rr.t that will test signature creation if Net::DNS::SEC is available and can be loaded. Feature async nameserver behaviour. In rt.cpan.org 14622 Robert Stone suggested: The fact that it needs to take over the main running thread limits its audience. Since many daemon programs are already driven by a top level select loop, it seems useful to provide an API for the user to integrate Net::DNS::Nameserver processing to their own select loop. He also supplied example code for which he is hereby acknowledged. The patch was not used because simultaneously Robert Martin-Legène supplied a patch to Nameservers.pm that allowed the same async functionality through the use of loop_once method. Robert M-L's code also carefully manages the TCP sockets, so that they can deal with AXFRs. Robert S. has been so kind to review Robert M-L's code and is hereby kindly acknowledged. NB. Since the code may be subject to change the documentation of the loop_once method has been commented out. Fix bgsend srcaddr for IPv6 Achim Adam previously noticed that the source address wildard "::" works provides better portability than "0". We forgot to fix the bgsend() part earlier. Fix rt.cpan.org 14624 Fixed documentation of Nameserver.pm Replyhandler and fixed a bug that prevented the peerhost to be set. Fix rt.cpan.org 14700 mistyped _name2wire helper function name. Noticed and patched by Simon Josefsson. Fix rt.cpan.org 13944 Terminating dot not printed when printing SRV record. The SRV dname should be printed as FQDN, that is, including the dot at the end. Acknowledgments Jakob Schlyter. While adding the "dot" I noticed that in the fileformat parsing code there might be theoretical corner cases where rdata elements are not properly read. The code needs an audit for this. Fix srcport for socket creation in bgsend method Lionel Cons noted and patched a small bug in bgsocket creation code for lib/Net/DNS/Resolver/Base.pm *** 0.53_01 July 31, 2005 Fix rt.cpan.org 13809 "Phar" noted that the peerhost is never passed to the make_reply function in nameserver.pm and provided the trivial patch. Fix rt.cpan.org 13922 Fixed a problem with persistent TCP sockets which was introduced because of using the address family as an index to the array of persistent sockets. Used AF_UNSPEC for the array index for the TCP socket; just to choose a number. The key to the persistent sockets is the remote nameserver:port combination. Acknowledgments to Mike Mitchell for reporting the bug and testing the solution. Feat t/01-resolve will not try to do tests from private IP space; hopefully that cuts down on the number of false positives. *** 0.53 July 22, 2005 Fix rt.cpan.org 13669 Danny Thomas provided a somewhat more elegant line of code for the typesbyval regexp. Fix rt.cpan.org 13534 Net::DNS::Resolver::Recurse would bail out when it happened to run into lame servers. Doc rt.cpan.org 13387 Documented the BUG caught by Robert Martin-Legène Net::DNS::Nameserver running with multiple IP interfaces might violate section 4 of RFC2181. Fix IPv6 on AIX Binding to the local interface did not work when local address was specified as "0" instead of "::". The problem was identified, reported and fixed by Achim Adam. Fix rt.cpan.org 13232 One uncaught AF_INET6. *** 0.52 July 1, 2005 Feature Net::DNS::RR::OPT added the the size(), do(),set_do() and clear_do() methods. *** 0.51_02 June 22, 2005 Fix rt.cpan.org 13297 Persistent_udp option broken starting in version 0.50. This was fixed, based on a patch by Sidney Markowitz. Guido van Rooij independently submitted a similar patch. Fix rt.cpan.org 13289 Was caused by a typo. Fix rt.cpan.org 13243 and 13191 The escaped characters test failed on some system because the the systems dn_expand instead of the supplied dn_expand was used after the makemaker magic linked DNS.xs. This was fixed by renaming the dn_expand that comes with the library to netdns_dn_expand. Fix rt.cpan.org 13239: When queries are refused the resolver would not take the next nameserver on the nameserver list for its next try but skip one. I was also made aware that the "use byte" pragma is incompatible with pre 5.06 perl. BEGIN { eval { require bytes; } } It should be noted that for perl versions < 5.006 I had to disable the escaped character test. Don't expect domain names with labels that contain anything else than host names to work for versions earlier than perl 5.6.0. Thanks to Vladimir Kotal for the assistance in testing the code on his system and the members of the NL-PM list for suggestions and education. *** 0.51_01 June 14, 2005 Fix rt.cpan.org 13232: Replaced IF_INET6 by IF_INET6() so that use strict subs does not complain in the absence of a definition of IF_INET6 in earlier versions perl that did not have IF_INET6 defined in Socket.pm The problem is similar to the problem described in: http://lists.ee.ethz.ch/mrtg-developers/msg00198.html *** 0.51 June 10, 2005 Fix rt.cpan.org 13184: Removed a 'stale' debug line (oops). A "stale" debug line may cause clutter in log files which may cause false positives on log analysis tools. Harmful enough to warrant a quick patch. *** 0.50 June 8, 2005 No changes with respect to 0.49_03. *** 0.49_03 June 1, 2005 (Version 0.50 release candidate 3) Fix: Concatenation of scalars caused modification of data because of Perl's habit to treat scalars as utf characters instead of bytes. Inserted use bytes pragma throughout the code base. DNS is done in octets. Feature: Added "ignqrid" as an attribute to the Resolver. use as: ok (my $res=Net::DNS::Resolver->new(nameservers => ['127.0.0.1'], port => 5354, recurse => 0, igntc => 1, ignqrid => 1, ), When the attribute is set to a non-zero value replies with the qr bit clear and replies with non-matching query ids are happily accepted. This opens the possibility to accept spoofed answers. YOU CAN BURN YOURSELF WITH THIS FEATURE. It is set to 0 per default and remains, except for this changes file an undocumented feature. *** 0.49_02 May 28, 2005 (Version 0.50 release candidate 2) Fix: Smoking Gun tests for non-cygwin Win32. Makefile.PL failed to produce a proper Makefile under win32. (e.g. www,nntp.perl.org/group/perl.cpan.testers/210570) I worked around that by moving the library into the base directory of the distribution as the "subdir" section seemed to be all funny. Fix: rt.cpan.org#11931 (the off-topic part) Sidney Markowitz spotted an awkward condition that rarely happens but is significant enough to be dealt with. In the send_udp method there are two loops: one over the nameservers and one that waits for the sockets to come forward with data. That second loop will sometimes timeout and then be entered with a repeated query to the same nameserver. It occasionally happens that the old packet arrives on the socket. That packet is discarded but the loop does not return to the loop to wait for the remainder of the timeout period for an answer on the second query, that may still arrive. This has now been fixed. Thanks to Sidney for the assessment of the problem and the fix. *** 0.49_01 (Version 0.50 release candidate 1) Fix: Makefile.PL: Minor tweak to recognize Mac OS X 10.4 not so relevant since netdnslib is distributed with the code. Feature: Calling the Net::DNS::Resolver::dnssec method with a non-zero argument will set the udppacketsize to 2048. The method will also carp a warning if you pass a non-zero argument when Net::DNS::SEC is not installed. Feature: IPv6 transport support IPv6 transport has been added to the resolver and to the nameserver code. To use IPv6 please make sure that you have IO::Socket::INET6 version 2.01 or later installed. If IPv6 transport is available Net::DNS::Resolver::Recurse will make use of it (picking randomly between IPv4 and IPv6 transport) use the force_v4() method to only force IPv4. Feature: Binary characters in labels RFC 1035 3.1: Domain names in messages are expressed in terms of a sequence of labels. Each label is represented as a one octet length field followed by that number of octets. Since every domain name ends with the null label of the root, a domain name is terminated by a length byte of zero. The high order two bits of every length octet must be zero, and the remaining six bits of the length field limit the label to 63 octets or less. Unfortunately dname attributes are stored strings throughout Net::DNS. (With hindsight dnames should have had their own class in which one could have preserved the wire format.). To be able to represent all octets that are allowed in domain names I took the approach to use the "presentation format" for the attributes. This presentation format is defined in RFC 1035 5.1. I added code to parse presentation format domain names that has escaped data such as \ddd and \X (where X is not a number) to wireformat and vice verse. In the conversion from wire format to presentation format the characters that have special meaning in a zone file are escaped (so that they can be cut-n-pasted without pain). These are " (0x22), $ (0x24), (0x28), ) (0x29), . (0x2e) , ; (0x3b), @ (ox40) and \ (0x5c). The number between brackets representing the ascii code in hex. Note that wherever a name occurs as a string in Net::DNS it is now in presentation format. For those that dealt with 'hostnames' (subset of all possible domain names) this will be a completely transparent change. Details: I added netdnslib which contains Net::DNS's own dn_expand. Its implemented in C and the source is a hodgepodge of Berkeley based code and snippets from ISC's bind9 distribution. The behavior, in terms of which chars are escaped, is similar to bind9. There are some functions added to DNS.pm that do conversion from presentation and wire format and back. They should only be used internally (although they live in EXPORT_OK.) For esoteric test cases see t/11-escapedchars.t. Fix: rt.cpan.org #11931 Applied the patch suggested by "Sidney". It is a practical workaround that may not be portable to all versions of the OS from Redmond. See the ticket for details. *** 0.49 March 29, 2005 No changes wrt 0.48_03. *** 0.48_03 March 22, 2005 (Version 0.49 release candidate 3) Fix: Only remove leading zeros in the regular expressions for typesbyval and classbyval methods. (patch by Ronald v.d. Pol) Fix: Properly return an empty array in the authority, additional and answer methods (patch by Ronald v.d. Pol) Fix: rt.cpan.org #11930 Incorrect searchlist duplication removal in Net::DNS::Resolver::Win32 Patch courtesy Risto Kankkunen. Problem: rt.cpan.org #11931 Win32.pm used the DNSRegisteredAdapters registry key to determine which local forwarders to send queries to. This is arguably the wrong key as it is used to identify the server which to send dynamic updates to. A real fix for determining the set of nameservers to query has not been implemented. For details see https://rt.cpan.org/Ticket/Display.html?id=11931 *** 0.48_02 March 14, 2005 (Version 0.49 release candidate 2) Fix: Bug report by Bernhard Schmidt (concerning a bug on the IPv6 branch). The bug caused dname compression to fail and to create compression pointers causing loops. *** 0.48_01 March 7, 2005 (Version 0.49 release candidate 1) Fix: rt.cpan.org #8882 No redundant lookups on SERVFAIL response and #6149 Does not search multiple DNS servers Net::DNS::Resolver will now use the other nameservers in the list if the RCODE of the answer is not NOERROR (0) or NXDOMAIN (3). When send() exhausted the last nameserver from the it will return the answer that was received from the last nameserver that responded with an RCODE. The errorstring will be set to "RCODE: " Fix: rt.cpan.org #8803 TXT records don't work with semicolons Since we are expecting "zonefile" presentation at input a comment will need to be escaped ( \; ). It could be argued that this is a to strict interpretation of 1035 section 5.1. While working on this I discovered there are more problems with TXT RRs. Eg; 0100 is a perfectly legal character string that should be represented as "\000" in a zonefile. Net::DNS does pass character strings with "non-ASCII" chars from the wire to the char_str_lst array but the print functions do not properly escape them when printing. Properly dealing with zonefile presentation format and binary data is still to be done. Fix: rt.cpan.org Ticket #8483 eval tests for DNS::RR::SIG fail when using a die handler (Thanks Sebastiaan Hoogeveen) Patch applied. Fix: rt.cpan.org: Ticket #8608 Net::DNS::Packet->data makes incorrect assumptions Implemented the "pop" method for the question. Since having a qcount that is not 1 is somewhat rare (it appears in TCP AXFR streams) the ability to pop the answer from a question has not been documented in the "pod" Also fixed the incorrect assumption. (Thanks Bruce Campbell.) Fix: Ticket #11106 Incorrect instructions in README Corrected in the README and in Makefile.PL Olaf Kolkman took over maintenance responsibility from Chris Reinhardt. This involved importing the code into another subversion repository. I made sure the numbers jumped, but I did not have access to the "original" subversion repository so I lost some of the history. *** 0.48 Aug 12, 2004 Net::DNS is now stored in a subversion repository, replacing cvs. As such the submodule version numbers have taken another big jump. Luckily those numbers don't matter as long as they work. Fixed a bug with Unknown RR types that broke zone signing [Olaf]. Added callback support to Net::DNS::Resolver::Recurse. The demo/trace_dns.pl script demonstrates this. Added a note regarding answers with an empty answer section to the Net::DNS::Resolver::search() and Net::DNS::Resolver::query() documentation. The copyright notice for Net::DNS::RR::SSHFP was incorrect. That file is Copyright (c) 2004 RIPE NCC, Olaf Kolkman. *** 0.47_01 May 6, 2004 ** NOTICE ** RR subclasses no longer pull in parts of Net::DNS; Net::DNS is assumed to be up and running when the subclass is compiled. If you were using a RR subclass directly, this may break your code. It was never documented that you could use them directly however, so hopefully you never did... Fixed bug where SRV records with a priority of 0 did not function correctly. CPAN #6214 Calls to various constants where using the &NAME syntax, which is not inlined. Changed to NAME(). Added SSHFP support. [Olaf] CERT fixes. [Olaf] *** 0.47 April 1, 2004 safe_push() is back in Net::DNS::Packet, due to the excellent debate skills of Luis E Monoz. However, the name safe_push() is deprecated, use the new name unique_push() instead. Fixed a bug in Net::DNS::Nameserver which caused the class to build packets incorrectly in some cases. [Ask Bjorn Hansen] Error message cleanups in Net::DNS::typesbyname() and Net::DNS::typesbyval() [Ask Bjorn Hansen] Net::DNS::RR::new_from_hash() now works with unknown RR types [Olaf]. *** 0.46 February 21, 2004 IPv6 reverse lookups can now be done with Net::DNS::Resolver::search(), as well as with query(). Hostnames can now be used in the 'nameservers' argument to Net::DNS::Resolver->new() *** 0.45_01 February 9, 2004 Net::DNS now uses UDP on windows. Removed Net::DNS::Select from the package. IO::Select appears to work on windows just fine. Fixed a bug that caused MXes with a preference of 0 to function incorrectly, reported by Dick Franks. Net::DNS had a few problems running under taint mode, especially under cygwin. These issues have been fixed. More issues with taint mode may lie undiscovered. Applied Matthew Darwin's patch added support for IPv6 reverse lookups to Net::DNS::Resolver::query. *** 0.45 January 8, 2004 No changes from 0.44_02. ** 0.44_02 January 3, 2004 The XS detection code was broken. We actually use the XS bits now. Major cleanups/optimizations of the various RR subclasses. This release of Net::DNS is over twice as fast at parsing dns packets as 0.44. ** NOTICE ** $rr->rdatastr no longer returns '; no data' if the RR record has no data. This happens in $rr->string now. Net::DNS::Packet::safe_push() no longer exists. The method is now only available from Net::DNS::Update objects. ** 0.44_01 January 3, 2004 Net::DNS::RR objects were not playing nice with Storable, this caused the axfr demo script to fail. Thanks to Joe Dial for the report. ** NOTICE ** This may cause RR objects that are already serialize to not deserialize correctly. Reply handlers in Net::DNS::Nameserver are now passed the query object. Fixed a nasty bug in Nameserver.pm related to the qr bit. As Olaf explained: Replies are sent if the query has its "qr" bit set. The "qr" bit is an indication that the packet is sent as a response to a query. Since there are more implementations that suffer from this bug one can cause all kinds of nasty ping-pong loops by spoofing the initial packet or have an infinite query loop by spoofing a query from the localhost:53 address. Various Win32/Cygwin cleanups from Sidney Markowitz. *** 0.44 December 12, 2003 The Wrath of CPAN Release. CPAN.pm doesn't understand the nature of revision numbers. 1.10 is newer than 1.9; but CPAN.pm treats them as floats. This is bad. All the internal version numbers in Net::DNS have been bumped to 2.100 in order to fix this. No actual code changes in this release. *** 0.43 December 11, 2003 Added warning of deprecation of Net::DNS::Packet::safe_push. This will move into Net::DNS::Update, as Net::DNS::Update is now a proper subclass of Net::DNS::Packet. ** 0.42_02 December 11, 2003 Fixed a long standing bug with zone transfers in the "many-answers" format. CPAN #1903. Added the '--online-tests' flag to Makefile.PL. This activates the online tests without asking the user interactively. "--no-online-tests" turns the tests off. Cleaned up Makefile.PL a little. The "--pm" flag is now deprecated, use "--no-xs" instead. Added support for unknown RR types (rfc3597). Note for developers: the typesbyname, typesbyval, classesbyname and classesbyval hashes should not be used directly, use the same named wrapper functions instead. [Olaf Kolkman] Added two hashes for administrative use; they store which types are qtypes and metatypes (rfc2929). [Olaf Kolkman] ** 0.42_01 November 30, 2003 Major work to get Net::DNS functioning properly on Cygwin by Sidney Markowitz. Fixed a bug in Net::DNS::Nameserver's error handling. CPAN #4195 *** 0.42 October 26, 2003 Fixed compilation problems on panther (Mac OS 10.3). Fixed a bug in Net::DNS::Resolver::Recurse which allowed an endless loop to arise in certain situations. (cpan #3969, patch by Rob Brown) Applied Mike Mitchell's patch implementing a persistent UDP socket. See the Net::DNS::Resolver documentation for details. *** 0.41 October 3, 2003 Added some documentation about modifying the behavior of Net::DNS::Resolver. ** 0.40_01 September 26, 2003 Fixed some uninitialized value warnings when running under windows. Fixed a bug in the test suite that caused 00-version.t to fail with certain versions of ExtUtils::MakeMaker. Thanks to David James, Jos Boumans and others for reporting it. Reply handlers in Net::DNS::Nameserver are now passed the peerhost. (Assen Totin ) Reply handlers in Net::DNS::Nameserver can now tweak the header bits that the nameserver returns. [Olaf] The AD header bit is now documented, and twiddlable. [Olaf] The change log has been trimmed, entries for versions older than 0.21 have been removed. ** NOTICE ** Net::DNS::Resolver::axfr_old() has been removed from the package. An exception will be thrown if you attempt to use this method. Use axfr() or axfr_start() instead. *** 0.40 September 1, 2003 Various POD tweaks. ** 0.39_02 August 28, 2003 Net-DNS-SEC updates, seems that IETF has been busy redefining DNSSEC. [Olaf] Added version to all the modules in the distribution. ** 0.39_01 August 12 2003 Added a META.yaml. The crystal ball says an upgrade to Module::Install may be coming soon. Changed how the versions of the various submodules were set. The CPAN indexer cannot execute "$VERSION = $Net::DNS::VERSION". The single line with the $VERSION assignment is pulled out of the file and eval'ed; at that time, Net::DNS is not loaded. The submodules now pull their version numbers out of CVS. *** 0.39 August 7 2003 Fixed a bug on Win32 where some machines separated lists with commas, not whitespace. Thanks to Jim White for pointing it out. ** 0.38_02 July 29 2003 Reworked the POD for Net::DNS::Resolver. When parsing resolver configuration files, IPv6 addresses are now skipped, as Net::DNS does not yet have IPv6 support. ** 0.38_01 Jun 22 2003 Broke Net::DNS::Resolver into separate classes. UNIX and Win32 classes are currently implemented. Many of the globals in Net::DNS::Resolver no longer exist. They were never documented so you never used them.... right? Options to Net::DNS::Resolver->new() are now supported, including using your own configuration file. See the Net::DNS::Resolver man page for details. Tweaked Net::DNS::RR::TXT to fail more gracefully when the quotes in the data section are not balanced. Add more tests (of course). Moved next_id() from Resolver.pm to Header.pm (which is where it is used). Net::DNS::Select now uses $^O directly, this means that the second argument to Net::DNS::Select::new() (the OS) is now ignored. *** 0.38 Jun 5 2003 Various buglets fixed in the new Makefile.PL. Use Dynaloader instead of XSLoader. Turns out that XSLoader is only in more recent perls. Added deprecation warning to Net::DNS::Resolver::axfr_old(). HP-UX fixes [cpan #2710], I don't have the name of the reporter/patcher. *** 0.37 May 28 2003 Renamed the test C file to compile.c, test.c was confusing the 'make test' target. *** 0.36 May 28 2003 Removed Rob Brown's RPM stuff. Something odd happened in the 0.35 tarball and at the moment I don't have the time to investigate. *** 0.35 May 26 2003 POD fixes, added tests for POD. *** 0.34_03 May 22 2003 Reworked Makefile.PL to try and detect if you have a working C compiler. Added '--pm' and '--xs' command line options to Makefile.PL Fixed linking problem on linux. Tie::DNSHash removed from the package, see Tie::DNS from CPAN for a more complete implementation of a DNS hash. *** 0.34_02 May 21 2003 Net::DNS::Packet::dn_expand is now implemented using the function of the same name from libresolv. This method of decompressing names is around twice as fast as the perl implementation. Applied Jan Dubois's patch to fix nameserver lookup on Windows 2000/95/98/ME. *** 0.34 6 Mar 2003 Applied David Carmean's patch for handling more than one string in a TXT RR's RDATA section. Applied Net::DNS::Resolver::Recurse bug fixes from Rob Brown. Added check of the answer's rcode in Net::DNS::Resolver::axfr_next(). Applied Kenneth Olving Windows changes. Applied patch from Dan Sully (daniel@electricrain.com) allowing multiple questions to be part of a DNS packet. *** 0.33 8 Jan 2003 Fixed 00-load.t to skip the Net::DNS::SEC modules. The test suite should now pass if you have Net::DNS::SEC installed. Fixed the regular expression in RR.pm to comply with the RFCs, turns out we were _too_ paranoid. [Olaf] *** 0.32 5 Jan 2003 Various cleanups for perl 5.004. Thanks to nathan@anderson-net.com ([cpan #1847]) Applied Olaf's SIG patch (thanks as always). Win32 now looks at the environment variables when building the configuration defaults. Thanks to net-dns-bug@oak-wood.co.uk (That's the only name I have... [cpan #1819]) Added Rob Brown's Net::DNS::Resolver::Recurse module. *** 0.31 17 Nov 2002 Applied Olaf's patch for an initialization bug in OPT.pm Applied Rob Brown's patch for udp timeouts. Added stuff from Rob Brown for making RPM creation easier. Fixed a typo in FAQ.pod that was making apropos and whatis grumpy. Thanks to Florian Hinzmann for pointing it out and a patch. *** 0.30 7 Nov 2002 Applied Andrew Tridgell's (tridge@samba.org) patch for TKEY support. Added Net::DNS::Packet->safe_push() to allow for automatically checking for duplicate RRs being pushed into a packet. Inspired by Luis Munoz. Added more tests. *** 0.29 2 Oct 2002 Fixed $_ from creeping out of scope in Resolver.pm. Thanks to Ilya Martynov for finding the problem and the patch to fix it. Fixed divide by zero bug there is no usable network interface(s). Thanks to twilliams@tfcci.com, misiek@pld.ORG.PL (and one other person that I can't seem to find the address of) for reports. *** 0.28 20 Aug 2002 Fixed a bug in the new AUTOLOAD routines that made it impossible to set attributes to '0'. Fixed a bug in the RR patch that broke many updates. *** 0.27 15 Aug 2002 Added (untested) support for perl 5.004. We now allow whitespace at the beginning of a RR. Fixed an issue that gave Net::DNS::SEC problems, %Net::DNS::RR::RR is now in a scope that the Net::DNS::SEC hook can see it from. Fixed SRV records. Fixed debug message in Net::DNS::Resolver::bgread(). *** 0.26 5 Aug 2002 Fixed various bugs in the test suite. Fixed warning in Net::DNS::RR::AUTOLOAD with perl 5.005. --- Olaf Kolkman Chris Reinhardt Michael Fuhr