rewrote a bunch of the perl to work after perl5 and it works when testing against zonetransfer.me, but security prevents it from working most other places.
This commit is contained in:
parent
9573e6d913
commit
5524f0cb70
408
dnswalk
408
dnswalk
|
|
@ -18,6 +18,14 @@
|
||||||
# -F Enable "facist" checking. (See man page)
|
# -F Enable "facist" checking. (See man page)
|
||||||
# -l Check lame delegations
|
# -l Check lame delegations
|
||||||
|
|
||||||
|
#
|
||||||
|
# modern perl needs this explicitly globalized:
|
||||||
|
#
|
||||||
|
# File-scope "globals"
|
||||||
|
my %errlist;
|
||||||
|
my %num_error;
|
||||||
|
|
||||||
|
|
||||||
use Getopt::Std;
|
use Getopt::Std;
|
||||||
use IO::Socket;
|
use IO::Socket;
|
||||||
use Net::DNS;
|
use Net::DNS;
|
||||||
|
|
@ -38,8 +46,9 @@ if ($opt_D) {
|
||||||
}
|
}
|
||||||
($domain = $ARGV[0]) =~ tr/A-Z/a-z/;
|
($domain = $ARGV[0]) =~ tr/A-Z/a-z/;
|
||||||
if ($domain !~ /\.$/) {
|
if ($domain !~ /\.$/) {
|
||||||
die "Usage: dnswalk domain\ndomain MUST end with a '.'\n";
|
die "Usage: dnswalk domain\ndomain MUST end with a '.'\n \tOptions:\n \t\t-r\tRecursively descend subdomains of domain\n \t\t-i\tSuppress check for invalid characters in a domain name.\n \t\t-a\tturn on warning of duplicate A records.\n \t\t-d\tDebugging\n \t\t-m\tCheck only if the domain has been modified. (Useful only if\n \t\t\tdnswalk has been run previously.)\n \t\t-F\tEnable 'facist' checking. (See man page)\n \t\t-l\tCheck lame delegations\n\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
if (! -d $basedir) {
|
if (! -d $basedir) {
|
||||||
mkdir($basedir,0777) || die "FAIL: Cannot create $basedir: $!\n";
|
mkdir($basedir,0777) || die "FAIL: Cannot create $basedir: $!\n";
|
||||||
}
|
}
|
||||||
|
|
@ -67,268 +76,252 @@ sub dowalk {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# try to get a zone transfer, trying each listed authoritative server if
|
# try to get a zone transfer, trying each listed authoritative server if
|
||||||
# if fails.
|
# if fails.
|
||||||
sub doaxfr {
|
sub doaxfr {
|
||||||
local ($domain)=@_[0];
|
my ($domain) = @_;
|
||||||
local (%subdoms)=();
|
my %subdoms;
|
||||||
local ($subdom);
|
my @servers = getauthservers($domain);
|
||||||
local(@servers) = &getauthservers($domain);
|
|
||||||
&printerr("BAD", "$domain has only one authoritative nameserver\n")
|
printerr("BAD", "$domain has only one authoritative nameserver\n")
|
||||||
if (scalar(@servers) == 1);
|
if scalar(@servers) == 1;
|
||||||
&printerr("BAD", "$domain has NO authoritative nameservers!\n")
|
printerr("BAD", "$domain has NO authoritative nameservers!\n")
|
||||||
if (scalar(@servers) == 0);
|
if scalar(@servers) == 0;
|
||||||
|
|
||||||
|
my @zone;
|
||||||
|
|
||||||
SERVER:
|
SERVER:
|
||||||
foreach $server (@servers) {
|
foreach my $server (@servers) {
|
||||||
print STDERR "Getting zone transfer of $domain from $server...";
|
print STDERR "Getting zone transfer of $domain from $server...";
|
||||||
my $res = new Net::DNS::Resolver;
|
|
||||||
|
my $res = Net::DNS::Resolver->new;
|
||||||
$res->nameservers($server);
|
$res->nameservers($server);
|
||||||
|
|
||||||
@zone = $res->axfr($domain);
|
@zone = $res->axfr($domain);
|
||||||
|
|
||||||
unless (@zone) {
|
unless (@zone) {
|
||||||
print STDERR "failed\n";
|
print STDERR "failed\n";
|
||||||
&printerr("FAIL",
|
printerr("FAIL", "Zone transfer of $domain from $server failed: " . $res->errorstring . "\n");
|
||||||
"Zone transfer of $domain from $server failed: ".
|
|
||||||
$res->errorstring. "\n");
|
|
||||||
next SERVER;
|
next SERVER;
|
||||||
}
|
}
|
||||||
@subdoms=undef;
|
|
||||||
foreach $rr (@zone) {
|
foreach my $rr (@zone) {
|
||||||
if ($rr->type eq "NS") {
|
if ($rr->type eq "NS") {
|
||||||
$subdom = $rr->name;
|
my $subdom = lc($rr->name); # lowercase for comparison
|
||||||
$subdom =~ tr/A-Z/a-z/;
|
if (!equal($subdom, $domain) && !$subdoms{$subdom}) {
|
||||||
if ((!&equal($subdom,$domain)) && ( !$subdoms{$subdom})) {
|
|
||||||
$subdoms{$subdom} = 1;
|
$subdoms{$subdom} = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
print STDERR "done.\n";
|
print STDERR "done.\n";
|
||||||
last SERVER;
|
last SERVER; # Exit loop after successful transfer
|
||||||
} # foreach #
|
|
||||||
unless (@zone) {
|
|
||||||
&printerr("BAD","All zone transfer attempts of $domain failed!\n");
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
return (keys %subdoms);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
unless (@zone) {
|
||||||
|
printerr("BAD", "All zone transfer attempts of $domain failed!\n");
|
||||||
|
return ();
|
||||||
|
}
|
||||||
|
|
||||||
|
return keys %subdoms;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
sub getauthservers {
|
sub getauthservers {
|
||||||
my ($domain)=$_[0];
|
my ($domain) = @_;
|
||||||
my ($master)=&getmaster($domain);
|
return unless $domain;
|
||||||
my ($foundmaster)=0;
|
|
||||||
my ($ns);
|
my $master = getmaster($domain);
|
||||||
my ($ns_tmp);
|
return unless $master; # No SOA/master found, abort.
|
||||||
my ($res);
|
|
||||||
my ($ns_req);
|
my $res = Net::DNS::Resolver->new;
|
||||||
my (@servers);
|
my $ns_req = $res->query($domain, "NS");
|
||||||
my (%servhash);
|
|
||||||
return if (!$master); # this is null if there is no SOA or not found
|
unless (defined $ns_req && $ns_req->header->ancount > 0) {
|
||||||
return if (!$domain);
|
printerr("FAIL", "No nameservers found for $domain: " . $res->errorstring . "\n");
|
||||||
$res = new Net::DNS::Resolver;
|
return;
|
||||||
$ns_req = $res->query($domain, "NS");
|
}
|
||||||
&printerr("FAIL", "No nameservers found for $domain: ".
|
|
||||||
$res->errorstring ."\n")
|
my @servers;
|
||||||
unless (defined($ns_req) and ($ns_req->header->ancount > 0));
|
my %servhash;
|
||||||
foreach $ns ($ns_req->answer) {
|
my $foundmaster = 0;
|
||||||
$ns_tmp = $ns->nsdname;
|
|
||||||
$ns_tmp =~ tr/A-Z/a-z/;
|
foreach my $ns_rr ($ns_req->answer) {
|
||||||
if (&equal($ns_tmp,$master)) {
|
my $ns_name = lc($ns_rr->nsdname);
|
||||||
$foundmaster=1; # make sure the master is at the top
|
|
||||||
|
if (equal($ns_name, $master)) {
|
||||||
|
$foundmaster = 1; # Put master at top
|
||||||
} else {
|
} else {
|
||||||
push(@servers,$ns_tmp) if ($servhash{$ns_tmp}++<1);
|
unless ($servhash{$ns_name}) {
|
||||||
|
push @servers, $ns_name;
|
||||||
|
$servhash{$ns_name} = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if ($foundmaster) {
|
|
||||||
unshift(@servers,$master);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Put master at the top if found
|
||||||
|
unshift @servers, $master if $foundmaster;
|
||||||
|
|
||||||
return @servers;
|
return @servers;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
# return 'master' server for zone
|
# return 'master' server for zone
|
||||||
sub getmaster {
|
sub getmaster {
|
||||||
my ($zone)=$_[0];
|
my ($zone) = @_;
|
||||||
my ($res) = new Net::DNS::Resolver;
|
|
||||||
my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN");
|
return "" unless $zone;
|
||||||
my ($soa_req) = $res->send($packet);
|
|
||||||
unless (defined($soa_req)) {
|
my $res = Net::DNS::Resolver->new;
|
||||||
&printerr("FAIL", "Cannot get SOA record for $zone:".
|
my $soa_req = $res->query($zone, "SOA");
|
||||||
$res->errorstring ."\n");
|
|
||||||
|
unless (defined $soa_req) {
|
||||||
|
printerr("FAIL", "Cannot get SOA record for $zone: " . $res->errorstring . "\n");
|
||||||
return "";
|
return "";
|
||||||
}
|
}
|
||||||
unless (($soa_req->header->ancount >= 1) &&
|
|
||||||
(($soa_req->answer)[0]->type eq "SOA")) {
|
foreach my $rr ($soa_req->answer) {
|
||||||
&printerr("BAD", "SOA record not found for $zone\n");
|
if ($rr->type eq "SOA") {
|
||||||
|
return $rr->mname;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
printerr("BAD", "SOA record not found for $zone\n");
|
||||||
return "";
|
return "";
|
||||||
}
|
}
|
||||||
return ($soa_req->answer)[0]->mname;
|
|
||||||
}
|
|
||||||
|
|
||||||
# open result of zone tranfer and check lots of nasty things
|
# open result of zone tranfer and check lots of nasty things
|
||||||
# here's where the fun begins
|
# here's where the fun begins
|
||||||
|
use Net::DNS;
|
||||||
|
use Socket;
|
||||||
|
|
||||||
sub check_zone {
|
sub check_zone {
|
||||||
my ($domain)=$_[0];
|
my ($domain) = @_;
|
||||||
local (%glues)=(); # look for duplicate glue (A) records
|
my %glues;
|
||||||
local ($name, $aliases, $addrtype, $length, @addrs);
|
my ($name, $aliases, $addrtype, $length, @addrs);
|
||||||
local ($prio,$mx);
|
my $lastns;
|
||||||
local ($soa,$contact);
|
|
||||||
local ($lastns); # last NS record we saw
|
foreach my $rr (@zone) {
|
||||||
local (@keys); # temp variable
|
# Warn about invalid characters in A or MX names
|
||||||
foreach $rr (@zone) {
|
if (($rr->type eq "A" || $rr->type eq "MX") && !$opt_i && $rr->name =~ /[^\*][^-A-Za-z0-9.]/) {
|
||||||
# complain about invalid chars only for mail names
|
printerr("WARN", $rr->name . ": invalid character(s) in name\n");
|
||||||
if ((($rr->type eq "A") || ($rr->type eq "MX")) && (!$opt_i) &&
|
|
||||||
($rr->name =~ /[^\*][^-A-Za-z0-9.]/)) {
|
|
||||||
&printerr("WARN", $rr->name .": invalid character(s) in name\n");
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($rr->type eq "SOA") {
|
if ($rr->type eq "SOA") {
|
||||||
print STDERR 's' if $opt_d;
|
print STDERR 's' if $opt_d;
|
||||||
my @soa = split(/\s+/, $rr->rdstring);
|
my @soa = split(/\s+/, $rr->rdstring);
|
||||||
my $rname = $soa[1];
|
my $rname = $soa[1];
|
||||||
print "SOA=" . $rr->mname . " contact=" . $rname . "\n";
|
print "SOA=" . $rr->mname . " contact=" . $rname . "\n";
|
||||||
# basic address check. No "@", and user.dom.ain (two or more dots)
|
|
||||||
if (($rname =~ /@/)||!($rname =~ /[^.]+(\.[^.]+){2,}/)) {
|
# Basic contact format check
|
||||||
&printerr("WARN", "SOA contact name (".
|
if ($rname =~ /@/ || $rname !~ /[^.]+(\.[^.]+){2,}/) {
|
||||||
$rname .") is invalid\n");
|
printerr("WARN", "SOA contact name (" . $rname . ") is invalid\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
} elsif ($rr->type eq "PTR") {
|
} elsif ($rr->type eq "PTR") {
|
||||||
print STDERR 'p' if $opt_d;
|
print STDERR 'p' if $opt_d;
|
||||||
if (scalar((@keys=split(/\./,$rr->name))) == 6 ) {
|
my @keys = split(/\./, $rr->name);
|
||||||
# check if forward name exists, but only if reverse is
|
if (scalar(@keys) == 6 && $keys[0] ne "0") {
|
||||||
# a full IP addr
|
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->ptrdname);
|
||||||
# skip ".0" networks
|
|
||||||
if ($keys[0] ne "0") {
|
|
||||||
($name, $aliases, $addrtype, $length,
|
|
||||||
@addrs)=gethostbyname($rr->ptrdname);
|
|
||||||
# if (!(($name, $aliases, $addrtype, $length,
|
|
||||||
# @addrs)=gethostbyname($rr->ptrdname))) {
|
|
||||||
# &printerr("FAIL", "gethostbyname(".
|
|
||||||
# $rr->ptrdname ."): $!\n");
|
|
||||||
# }
|
|
||||||
# else {
|
|
||||||
if (!$name) {
|
if (!$name) {
|
||||||
&printerr("WARN", $rr->name
|
printerr("WARN", $rr->name . " PTR " . $rr->ptrdname . ": unknown host\n");
|
||||||
." 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)) {
|
} elsif (!matchaddrlist($rr->name)) {
|
||||||
&printerr("WARN", $rr->name
|
printerr("WARN", $rr->name . " PTR " . $rr->ptrdname . ": A record not found\n");
|
||||||
." PTR ". $rr->ptrdname .": CNAME (to $name)\n");
|
|
||||||
}
|
|
||||||
elsif (!&matchaddrlist($rr->name)) {
|
|
||||||
&printerr("WARN", $rr->name
|
|
||||||
." PTR ". $rr->ptrdname .": A record not found\n");
|
|
||||||
}
|
|
||||||
# }
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} elsif (($rr->type eq "A") ) {
|
|
||||||
|
} elsif ($rr->type eq "A") {
|
||||||
print STDERR 'a' if $opt_d;
|
print STDERR 'a' if $opt_d;
|
||||||
# check to see that a reverse PTR record exists
|
my $packed_ip = pack('C4', split(/\./, $rr->address));
|
||||||
($name,$aliases,$addrtype,$length,@addrs)=gethostbyaddr(pack('C4',
|
($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($packed_ip, AF_INET);
|
||||||
split(/\./,$rr->address)),2);
|
|
||||||
if (!$name) {
|
if (!$name && $rr->address !~ /^255/) {
|
||||||
# hack - allow RFC 1101 netmasks encoding
|
printerr("WARN", $rr->name . " A " . $rr->address . ": no PTR record\n");
|
||||||
if ($rr->address !=~ /^255/) {
|
} elsif ($opt_F && $name && !equal($name, $rr->name)) {
|
||||||
&printerr("WARN", $rr->name ." A ".
|
# Ignore localhost and similar special cases
|
||||||
$rr->address .": no PTR record\n");
|
if (index((split(/\./, $rr->name, 2))[0] . "-", (split(/\./, $name, 2))[0]) == -1) {
|
||||||
|
printerr("WARN", $rr->name . " A " . $rr->address . ": points to $name\n")
|
||||||
|
if (split(/\./, $name))[0] ne "localhost";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($opt_F && !&equal($name,$rr->name)) {
|
|
||||||
# Filter out "hostname-something" (like "neptune-le0")
|
if ($main::opt_a) {
|
||||||
if (index(split (/\./, $rr->name, 2) . "-",
|
# Duplicate glue record detection
|
||||||
split (/\./, $name, 2)) == -1 ) {
|
if (!$glues{$rr->address}) {
|
||||||
&printerr("WARN", $rr->name ." A ".
|
|
||||||
$rr->address .": points to $name\n")
|
|
||||||
if ((split(/\./,$name))[0] ne "localhost");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if ($main'opt_a) {
|
|
||||||
# keep list in %glues, report any duplicates
|
|
||||||
if ($glues{$rr->address} eq "") {
|
|
||||||
$glues{$rr->address} = $rr->name;
|
$glues{$rr->address} = $rr->name;
|
||||||
}
|
} elsif ($glues{$rr->address} eq $rr->name && !equal($lastns, $domain)) {
|
||||||
elsif (($glues{$rr->address} eq $rr->name) &&
|
printerr("WARN", $rr->name . ": possible duplicate A record (glue of $lastns?)\n");
|
||||||
(!&equal($lastns,$domain))) {
|
|
||||||
&printerr("WARN", $rr->name
|
|
||||||
.": possible duplicate A record (glue of $lastns?)\n");
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
} elsif ($rr->type eq "NS") {
|
} elsif ($rr->type eq "NS") {
|
||||||
$lastns = $rr->name;
|
$lastns = $rr->name;
|
||||||
print STDERR 'n' if $opt_d;
|
print STDERR 'n' if $opt_d;
|
||||||
# check to see if object of NS is real
|
|
||||||
&checklamer($rr->name,$rr->nsdname) if ($main'opt_l);
|
checklamer($rr->name, $rr->nsdname) if $main::opt_l;
|
||||||
# check for bogusnesses like NS->IP addr
|
|
||||||
if (&isipv4addr($rr->nsdname)) {
|
if (isipv4addr($rr->nsdname)) {
|
||||||
&printerr("BAD", $rr->name
|
printerr("BAD", $rr->name . " NS " . $rr->nsdname . ": Nameserver must be a hostname\n");
|
||||||
." NS ". $rr->nsdname .": Nameserver must be a hostname\n");
|
|
||||||
}
|
}
|
||||||
($name, $aliases, $addrtype, $length,
|
|
||||||
@addrs)=gethostbyname($rr->nsdname);
|
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->nsdname);
|
||||||
# if (!(($name, $aliases, $addrtype, $length,
|
|
||||||
# @addrs)=gethostbyname($rr->nsdname))) {
|
|
||||||
# &printerr("FAIL", "gethostbyname(". $rr->nsdname ."): $!\n");
|
|
||||||
# }
|
|
||||||
# else {
|
|
||||||
if (!$name) {
|
if (!$name) {
|
||||||
&printerr("BAD", $rr->name
|
printerr("BAD", $rr->name . " NS " . $rr->nsdname . ": unknown host\n");
|
||||||
." NS ". $rr->nsdname .": unknown host\n");
|
} elsif (!equal($name, $rr->nsdname)) {
|
||||||
} elsif (!&equal($name,$rr->nsdname)) {
|
printerr("BAD", $rr->name . " NS " . $rr->nsdname . ": CNAME (to $name)\n");
|
||||||
&printerr("BAD", $rr->name
|
|
||||||
." NS ". $rr->nsdname .": CNAME (to $name)\n");
|
|
||||||
}
|
}
|
||||||
# }
|
|
||||||
} elsif ($rr->type eq "MX") {
|
} elsif ($rr->type eq "MX") {
|
||||||
print STDERR 'm' if $opt_d;
|
print STDERR 'm' if $opt_d;
|
||||||
# check to see if object of mx is real
|
|
||||||
if (&isipv4addr($rr->exchange)) {
|
if (isipv4addr($rr->exchange)) {
|
||||||
&printerr("BAD", $rr->name
|
printerr("BAD", $rr->name . " MX " . $rr->exchange . ": Mail exchange must be a hostname\n");
|
||||||
." MX ". $rr->exchange .": Mail exchange must be a hostname\n");
|
|
||||||
}
|
}
|
||||||
($name, $aliases, $addrtype, $length,
|
|
||||||
@addrs)=gethostbyname($rr->exchange);
|
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->exchange);
|
||||||
# if (!(($name, $aliases, $addrtype, $length,
|
|
||||||
# @addrs)=gethostbyname($rr->exchange))) {
|
|
||||||
# &printerr("FAIL", "gethostbyname(". $rr->exchange ."): $!\n");
|
|
||||||
# }
|
|
||||||
# else {
|
|
||||||
if (!$name) {
|
if (!$name) {
|
||||||
&printerr("WARN", $rr->name
|
printerr("WARN", $rr->name . " MX " . $rr->exchange . ": unknown host\n");
|
||||||
." 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") {
|
} elsif ($rr->type eq "CNAME") {
|
||||||
print STDERR 'c' if $opt_d;
|
print STDERR 'c' if $opt_d;
|
||||||
($name, $aliases, $addrtype, $length,
|
|
||||||
@addrs)=gethostbyname($rr->cname);
|
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->cname);
|
||||||
if (&isipv4addr($rr->cname)) {
|
|
||||||
&printerr("BAD", $rr->name
|
if (isipv4addr($rr->cname)) {
|
||||||
." CNAME ". $rr->cname .": alias must be a hostname\n");
|
printerr("BAD", $rr->name . " CNAME " . $rr->cname . ": alias must be a hostname\n");
|
||||||
}
|
}
|
||||||
# if (!(($name, $aliases, $addrtype, $length,
|
|
||||||
# @addrs)=gethostbyname($rr->cname))) {
|
|
||||||
# &printerr("FAIL", "gethostbyname(". $rr->cname ."): $!\n");
|
|
||||||
# }
|
|
||||||
# else {
|
|
||||||
if (!$name) {
|
if (!$name) {
|
||||||
&printerr("WARN", $rr->name
|
printerr("WARN", $rr->name . " CNAME " . $rr->cname . ": unknown host\n");
|
||||||
." CNAME ". $rr->cname .": unknown host\n");
|
} elsif (!equal($name, $rr->cname)) {
|
||||||
} elsif (!&equal($name,$rr->cname)) {
|
printerr("WARN", $rr->name . " CNAME " . $rr->cname . ": CNAME (to $name)\n");
|
||||||
&printerr("WARN", $rr->name
|
|
||||||
." CNAME ". $rr->cname .": CNAME (to $name)\n");
|
|
||||||
}
|
|
||||||
# }
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
print STDERR "\n" if $opt_d;
|
print STDERR "\n" if $opt_d;
|
||||||
close(FILE);
|
close(FILE);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# prints an error message, suppressing duplicates
|
# prints an error message, suppressing duplicates
|
||||||
sub printerr {
|
sub printerr {
|
||||||
my ($type, $err) = @_;
|
my ($type, $err) = @_;
|
||||||
if ($errlist{$err}==undef) {
|
|
||||||
|
unless (exists $errlist{$err}) {
|
||||||
print "$type: $err";
|
print "$type: $err";
|
||||||
$num_error{$type}++;
|
$num_error{$type}++;
|
||||||
print STDERR "!" if $opt_d;
|
print STDERR "!" if $opt_d;
|
||||||
|
|
@ -376,18 +369,17 @@ sub matchaddrlist {
|
||||||
# there's a better way to do this, it just hasn't evolved from
|
# there's a better way to do this, it just hasn't evolved from
|
||||||
# my brain to this program yet.
|
# my brain to this program yet.
|
||||||
sub byhostname {
|
sub byhostname {
|
||||||
@c = reverse(split(/\./,$a));
|
my @c = reverse split(/\./, $a);
|
||||||
@d = reverse(split(/\./,$b));
|
my @d = reverse split(/\./, $b);
|
||||||
for ($i=0;$i<=(($#c > $#d) ? $#c : $#d) ;$i++) {
|
|
||||||
|
my $max = @c > @d ? $#c : $#d;
|
||||||
|
for my $i (0 .. $max) {
|
||||||
next if $c[$i] eq $d[$i];
|
next if $c[$i] eq $d[$i];
|
||||||
return -1 if $c[$i] eq "";
|
return -1 if !defined($c[$i]) || $c[$i] eq "";
|
||||||
return 1 if $d[$i] eq "";
|
return 1 if !defined($d[$i]) || $d[$i] eq "";
|
||||||
if ($c[$i] eq int($c[$i])) {
|
if ($c[$i] =~ /^\d+$/ && $d[$i] =~ /^\d+$/) {
|
||||||
# numeric
|
|
||||||
return $c[$i] <=> $d[$i];
|
return $c[$i] <=> $d[$i];
|
||||||
}
|
} else {
|
||||||
else {
|
|
||||||
# string
|
|
||||||
return $c[$i] cmp $d[$i];
|
return $c[$i] cmp $d[$i];
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -396,21 +388,23 @@ sub byhostname {
|
||||||
|
|
||||||
sub checklamer {
|
sub checklamer {
|
||||||
my ($zone, $nameserver) = @_;
|
my ($zone, $nameserver) = @_;
|
||||||
my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN");
|
|
||||||
my ($soa_req);
|
my $res = Net::DNS::Resolver->new;
|
||||||
my ($res) = new Net::DNS::Resolver;
|
|
||||||
unless ($res->nameservers($nameserver)) {
|
unless ($res->nameservers($nameserver)) {
|
||||||
&printerr("FAIL", "Cannot find address for nameserver: ".
|
printerr("FAIL", "Cannot find address for nameserver: " . $res->errorstring . "\n");
|
||||||
$res->errorstring. "\n");
|
|
||||||
}
|
|
||||||
$soa_req = $res->send($packet);
|
|
||||||
unless (defined($soa_req)) {
|
|
||||||
&printerr("FAIL",
|
|
||||||
"Cannot get SOA record for $zone from $nameserver (lame?): ".
|
|
||||||
$res->errorstring ."\n");
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
&printerr("BAD", "$zone NS $nameserver: lame NS delegation\n")
|
|
||||||
unless ($soa_req->header->aa);
|
my $packet = Net::DNS::Packet->new($zone, "SOA", "IN");
|
||||||
|
my $soa_req = $res->send($packet);
|
||||||
|
|
||||||
|
unless (defined $soa_req) {
|
||||||
|
printerr("FAIL", "Cannot get SOA record for $zone from $nameserver (lame?): " . $res->errorstring . "\n");
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
unless ($soa_req->header->aa) {
|
||||||
|
printerr("BAD", "$zone NS $nameserver: lame NS delegation\n");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue