File dnswalk-my.patch of Package dnswalk
--- dnswalk.old/dnswalk 2018-07-11 12:35:36.893129681 +0200
+++ dnswalk.new/dnswalk 2018-07-11 12:36:40.846103490 +0200
@@ -17,12 +17,14 @@
# dnswalk has been run previously.)
# -F Enable "facist" checking. (See man page)
# -l Check lame delegations
+# -p Check PTR existence for A and AAAA
use Getopt::Std;
use IO::Socket;
use Net::DNS;
use Net::IP;
use Socket6;
+use Net::IPv6Addr;
getopts("D:rfiadmFl");
@@ -83,7 +85,7 @@
SERVER:
foreach $server (@servers) {
print STDERR "Getting zone transfer of $domain from $server...";
- my $res = new Net::DNS::Resolver;
+ my $res = new Net::DNS::Resolver( tcp_timeout=>2, udp_timeout=>1, retry=>1 );
$res->nameservers($server);
@zone=$res->axfr($domain);
unless (@zone) {
@@ -125,7 +127,7 @@
my (%servhash);
return if (!$master); # this is null if there is no SOA or not found
return if (!$domain);
- $res = new Net::DNS::Resolver;
+ $res = new Net::DNS::Resolver( tcp_timeout=>2, udp_timeout=>1, retry=>1 );
$ns_req = $res->query($domain, "NS");
&printerr("FAIL", "No nameservers found for $domain: " .
$res->errorstring . "\n")
@@ -148,7 +150,7 @@
# return 'master' server for zone
sub getmaster {
my ($zone)=$_[0];
- my ($res) = new Net::DNS::Resolver;
+ my ($res) = new Net::DNS::Resolver( tcp_timeout=>2, udp_timeout=>1, retry=>1 );
my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN");
my ($soa_req) = $res->send($packet);
unless (defined($soa_req)) {
@@ -196,25 +198,25 @@
@keys = split(/\./, $rr->name);
if (scalar(@keys) == 6 || scalar(@keys) == 34) {
$af = (scalar(@keys) == 6) ? AF_INET : AF_INET6;
+ $t = ($af == AF_INET) ? "A" : "AAAA";
# check if forward name exists, but only if reverse is
# a full IP addr
($name, $aliases, $addrtype, $length, @addrs) =
- gethostbyname($rr->ptrdname);
+ mygethostbyname($rr->ptrdname, $t);
if (!$name) {
&printerr("WARN", $rr->name . " PTR " . $rr->ptrdname .
": unknown host\n");
}
- elsif (!&equal($name,$rr->ptrdname)) {
- &printerr("WARN", $rr->name . " PTR " . $rr->ptrdname .
- ": CNAME (to $name)\n");
- }
+# elsif (!&equal($name,$rr->ptrdname)) {
+# &printerr("WARN", $rr->name . " PTR " . $rr->ptrdname .
+# ": CNAME (to $name)\n");
+# }
elsif (!&matchaddrlist($rr->name)) {
- $t = ($af == AF_INET) ? "A" : "AAAA";
&printerr("WARN", $rr->name . " PTR " . $rr->ptrdname .
": $t record not found\n");
}
}
- } elsif ($rr->type eq "A" || $rr->type eq "AAAA") {
+ } elsif ($opt_p && ($rr->type eq "A" || $rr->type eq "AAAA")) {
print STDERR 'a' if $opt_d;
$af = ($rr->type eq "A") ? AF_INET : AF_INET6;
# check to see that a reverse PTR record exists
@@ -259,13 +261,13 @@
": Nameserver must be a hostname\n");
}
($name, $aliases, $addrtype, $length,
- @addrs)=gethostbyname($rr->nsdname);
+ @addrs)=mygethostbyname($rr->nsdname,"A");
if (!$name) {
&printerr("BAD", $rr->name . " NS " . $rr->nsdname .
": unknown host\n");
- } elsif (!&equal($name,$rr->nsdname)) {
- &printerr("BAD", $rr->name . " NS " . $rr->nsdname .
- ": CNAME (to $name)\n");
+# } elsif (!&equal($name,$rr->nsdname)) {
+# &printerr("BAD", $rr->name . " NS " . $rr->nsdname .
+# ": CNAME (to $name)\n");
}
} elsif ($rr->type eq "MX") {
print STDERR 'm' if $opt_d;
@@ -275,29 +277,36 @@
": Mail exchange must be a hostname\n");
}
($name, $aliases, $addrtype, $length,
- @addrs)=gethostbyname($rr->exchange);
+ @addrs)=mygethostbyname($rr->exchange, "A");
if (!$name) {
&printerr("WARN", $rr->name . " MX " . $rr->exchange .
": unknown host\n");
}
- elsif (!&equal($name,$rr->exchange)) {
- &printerr("WARN", $rr->name . " MX " . $rr->exchange .
- ": CNAME (to $name)\n");
- }
+# elsif (!&equal($name,$rr->exchange)) {
+# &printerr("WARN", $rr->name . " MX " . $rr->exchange .
+# ": CNAME (to $name)\n");
+# }
} elsif ($rr->type eq "CNAME") {
print STDERR 'c' if $opt_d;
+# ($name, $aliases, $addrtype, $length,
+# @addrs)=mygethostbyname($rr->cname, "ANY");
($name, $aliases, $addrtype, $length,
- @addrs)=gethostbyname($rr->cname);
+ @addrs)=mygethostbyname($rr->cname, "A");
if (&isipaddr($rr->cname)) {
&printerr("BAD", $rr->name . " CNAME " . $rr->cname .
": alias must be a hostname\n");
}
if (!$name) {
- &printerr("WARN", $rr->name . " CNAME " . $rr->cname .
- ": unknown host\n");
- } elsif (!&equal($name,$rr->cname)) {
- &printerr("WARN", $rr->name . " CNAME " . $rr->cname .
- ": CNAME (to $name)\n");
+ ($name, $aliases, $addrtype, $length, @addrs)=mygethostbyname($rr->cname, "NAPTR");
+ if (!$name) {
+ ($name, $aliases, $addrtype, $length, @addrs)=mygethostbyname($rr->cname, "SRV");
+ if (!$name) {
+ &printerr("WARN", $rr->name . " CNAME " . $rr->cname . ": unknown host\n");
+ }
+ }
+# } elsif (!&equal($name,$rr->cname)) {
+# &printerr("WARN", $rr->name . " CNAME " . $rr->cname .
+# ": CNAME (to $name)\n");
}
}
}
@@ -341,18 +350,29 @@
return $ip->version;
}
sub matchaddrlist {
- local(@x) = reverse( split(/\./, $_[0]) );
+ my $name = shift;
+ #print "DEBUG: name=$name", $/;
+ local(@x) = reverse( split(/\./, $name) );
shift @x;
local($arpatype) = shift @x;
- if ($arpatype =~ /in-addr/i) {
- $match = pack('C4', @x);
- }
- else {
- $match = pack('H32', join('', @x));
- }
local($found)=0;
- foreach $i (@addrs) {
- $found=1 if ($i eq $match);
+ if ($arpatype =~ /in-addr/i) {
+ $match = join(".", @x );
+ foreach $i (@addrs) {
+ $found=1 if ($i->address eq $match);
+ }
+ } elsif ( $arpatype =~ /ip6/i) {
+ #print "DEBUG: arpatype=ip6", $/;
+ foreach $i (@addrs) {
+ $name .= '.';
+ my $x = new Net::IPv6Addr($i->address);
+ my $arpa = $x->to_string_ip6_int();
+ $arpa =~ s/INT/arpa/;
+ $arpa = lc( $arpa );
+ #print "DEBUG: arpa=$arpa", $/;
+ $found=1 if ($name eq $arpa);
+ }
+
}
return $found;
}
@@ -382,7 +402,7 @@
my ($zone,$nameserver)=@_;
my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN");
my ($soa_req);
- my ($res) = new Net::DNS::Resolver;
+ my ($res) = new Net::DNS::Resolver( tcp_timeout=>2, udp_timeout=>1, retry=>1 );
unless ($res->nameservers($nameserver)) {
&printerr("FAIL", "Cannot find address for nameserver: " .
$res->errorstring . "\n");
@@ -398,3 +418,23 @@
unless ($soa_req->header->aa);
return;
}
+
+sub mygethostbyname {
+ my $qname = shift;
+ my $type = shift;
+
+ #print "DEBUG: trying to resolve $qname|$type", $/;
+ my $res = Net::DNS::Resolver->new;
+ if ( my $dns_packet = $res->query($qname, $type) ) {
+ foreach my $question ( $dns_packet->question ) {
+ $name = $question->qname;
+ }
+ $length = $dns_packet->answersize;
+ @addrs = $dns_packet->answer;
+
+ return ($name, "", $type, $length, @addrs);
+ } else {
+ # print "ERROR: unable to resolve $qname|$type", $/;
+ }
+ return ();
+}
