From 5524f0cb70d7adf198b9de1a83ec064fb11cbd07 Mon Sep 17 00:00:00 2001 From: tekopsinc Date: Sun, 16 Mar 2025 14:42:32 -0500 Subject: [PATCH] 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. --- dnswalk | 484 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 239 insertions(+), 245 deletions(-) diff --git a/dnswalk b/dnswalk index 104fadb..867fd79 100755 --- a/dnswalk +++ b/dnswalk @@ -18,6 +18,14 @@ # -F Enable "facist" checking. (See man page) # -l Check lame delegations +# +# modern perl needs this explicitly globalized: +# +# File-scope "globals" +my %errlist; +my %num_error; + + use Getopt::Std; use IO::Socket; use Net::DNS; @@ -38,8 +46,9 @@ if ($opt_D) { } ($domain = $ARGV[0]) =~ tr/A-Z/a-z/; 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) { mkdir($basedir,0777) || die "FAIL: Cannot create $basedir: $!\n"; } @@ -67,274 +76,258 @@ sub dowalk { } } } + + # try to get a zone transfer, trying each listed authoritative server if # if fails. sub doaxfr { - local ($domain)=@_[0]; - local (%subdoms)=(); - local ($subdom); - local(@servers) = &getauthservers($domain); - &printerr("BAD", "$domain has only one authoritative nameserver\n") - if (scalar(@servers) == 1); - &printerr("BAD", "$domain has NO authoritative nameservers!\n") - if (scalar(@servers) == 0); + my ($domain) = @_; + my %subdoms; + my @servers = getauthservers($domain); + + printerr("BAD", "$domain has only one authoritative nameserver\n") + if scalar(@servers) == 1; + printerr("BAD", "$domain has NO authoritative nameservers!\n") + if scalar(@servers) == 0; + + my @zone; + SERVER: - foreach $server (@servers) { + foreach my $server (@servers) { print STDERR "Getting zone transfer of $domain from $server..."; - my $res = new Net::DNS::Resolver; - $res->nameservers($server); - @zone=$res->axfr($domain); - unless (@zone) { - print STDERR "failed\n"; - &printerr("FAIL", - "Zone transfer of $domain from $server failed: ". - $res->errorstring. "\n"); - next SERVER; - } - @subdoms=undef; - foreach $rr (@zone) { + + my $res = Net::DNS::Resolver->new; + $res->nameservers($server); + + @zone = $res->axfr($domain); + + unless (@zone) { + print STDERR "failed\n"; + printerr("FAIL", "Zone transfer of $domain from $server failed: " . $res->errorstring . "\n"); + next SERVER; + } + + foreach my $rr (@zone) { if ($rr->type eq "NS") { - $subdom = $rr->name; - $subdom =~ tr/A-Z/a-z/; - if ((!&equal($subdom,$domain)) && ( !$subdoms{$subdom})) { - $subdoms{$subdom}=1; + my $subdom = lc($rr->name); # lowercase for comparison + if (!equal($subdom, $domain) && !$subdoms{$subdom}) { + $subdoms{$subdom} = 1; } } } + print STDERR "done.\n"; - last SERVER; - } # foreach # - unless (@zone) { - &printerr("BAD","All zone transfer attempts of $domain failed!\n"); - return undef; + last SERVER; # Exit loop after successful transfer } - return (keys %subdoms); + + unless (@zone) { + printerr("BAD", "All zone transfer attempts of $domain failed!\n"); + return (); + } + + return keys %subdoms; } + sub getauthservers { - my ($domain)=$_[0]; - my ($master)=&getmaster($domain); - my ($foundmaster)=0; - my ($ns); - my ($ns_tmp); - my ($res); - my ($ns_req); - my (@servers); - my (%servhash); - return if (!$master); # this is null if there is no SOA or not found - return if (!$domain); - $res = new Net::DNS::Resolver; - $ns_req = $res->query($domain, "NS"); - &printerr("FAIL", "No nameservers found for $domain: ". - $res->errorstring ."\n") - unless (defined($ns_req) and ($ns_req->header->ancount > 0)); - foreach $ns ($ns_req->answer) { - $ns_tmp = $ns->nsdname; - $ns_tmp =~ tr/A-Z/a-z/; - if (&equal($ns_tmp,$master)) { - $foundmaster=1; # make sure the master is at the top - } else { - push(@servers,$ns_tmp) if ($servhash{$ns_tmp}++<1); - } + my ($domain) = @_; + return unless $domain; + + my $master = getmaster($domain); + return unless $master; # No SOA/master found, abort. + + my $res = Net::DNS::Resolver->new; + my $ns_req = $res->query($domain, "NS"); + + unless (defined $ns_req && $ns_req->header->ancount > 0) { + printerr("FAIL", "No nameservers found for $domain: " . $res->errorstring . "\n"); + return; } - if ($foundmaster) { - unshift(@servers,$master); + + my @servers; + my %servhash; + my $foundmaster = 0; + + foreach my $ns_rr ($ns_req->answer) { + my $ns_name = lc($ns_rr->nsdname); + + if (equal($ns_name, $master)) { + $foundmaster = 1; # Put master at top + } else { + unless ($servhash{$ns_name}) { + push @servers, $ns_name; + $servhash{$ns_name} = 1; + } + } } + + # Put master at the top if found + unshift @servers, $master if $foundmaster; + return @servers; } + + # return 'master' server for zone sub getmaster { - my ($zone)=$_[0]; - my ($res) = new Net::DNS::Resolver; - my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN"); - my ($soa_req) = $res->send($packet); - unless (defined($soa_req)) { - &printerr("FAIL", "Cannot get SOA record for $zone:". - $res->errorstring ."\n"); - return ""; + my ($zone) = @_; + + return "" unless $zone; + + my $res = Net::DNS::Resolver->new; + my $soa_req = $res->query($zone, "SOA"); + + unless (defined $soa_req) { + printerr("FAIL", "Cannot get SOA record for $zone: " . $res->errorstring . "\n"); + return ""; } - unless (($soa_req->header->ancount >= 1) && - (($soa_req->answer)[0]->type eq "SOA")) { - &printerr("BAD", "SOA record not found for $zone\n"); - return ""; + + foreach my $rr ($soa_req->answer) { + if ($rr->type eq "SOA") { + return $rr->mname; + } } - return ($soa_req->answer)[0]->mname; + + printerr("BAD", "SOA record not found for $zone\n"); + return ""; } + + # open result of zone tranfer and check lots of nasty things # here's where the fun begins +use Net::DNS; +use Socket; + sub check_zone { - my ($domain)=$_[0]; - local (%glues)=(); # look for duplicate glue (A) records - local ($name, $aliases, $addrtype, $length, @addrs); - local ($prio,$mx); - local ($soa,$contact); - local ($lastns); # last NS record we saw - local (@keys); # temp variable - foreach $rr (@zone) { - # complain about invalid chars only for mail names - 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"); + my ($domain) = @_; + my %glues; + my ($name, $aliases, $addrtype, $length, @addrs); + my $lastns; + + foreach my $rr (@zone) { + # Warn about invalid characters in A or MX names + 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") { - print STDERR 's' if $opt_d; - my @soa = split(/\s+/,$rr->rdstring); - my $rname = $soa[1]; - print "SOA=". $rr->mname ." contact=". $rname ."\n"; - # basic address check. No "@", and user.dom.ain (two or more dots) - if (($rname =~ /@/)||!($rname =~ /[^.]+(\.[^.]+){2,}/)) { - &printerr("WARN", "SOA contact name (". - $rname .") is invalid\n"); - } + print STDERR 's' if $opt_d; + my @soa = split(/\s+/, $rr->rdstring); + my $rname = $soa[1]; + print "SOA=" . $rr->mname . " contact=" . $rname . "\n"; + + # Basic contact format check + if ($rname =~ /@/ || $rname !~ /[^.]+(\.[^.]+){2,}/) { + printerr("WARN", "SOA contact name (" . $rname . ") is invalid\n"); + } + } elsif ($rr->type eq "PTR") { print STDERR 'p' if $opt_d; - if (scalar((@keys=split(/\./,$rr->name))) == 6 ) { - # check if forward name exists, but only if reverse is - # a full IP addr - # 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) { - &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 (!&matchaddrlist($rr->name)) { - &printerr("WARN", $rr->name - ." PTR ". $rr->ptrdname .": A record not found\n"); - } -# } + my @keys = split(/\./, $rr->name); + if (scalar(@keys) == 6 && $keys[0] ne "0") { + ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->ptrdname); + + 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 (!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; - # check to see that a reverse PTR record exists - ($name,$aliases,$addrtype,$length,@addrs)=gethostbyaddr(pack('C4', - split(/\./,$rr->address)),2); - if (!$name) { - # hack - allow RFC 1101 netmasks encoding - if ($rr->address !=~ /^255/) { - &printerr("WARN", $rr->name ." A ". - $rr->address .": no PTR record\n"); - } - } - elsif ($opt_F && !&equal($name,$rr->name)) { - # Filter out "hostname-something" (like "neptune-le0") - if (index(split (/\./, $rr->name, 2) . "-", - split (/\./, $name, 2)) == -1 ) { - &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; - } - elsif (($glues{$rr->address} eq $rr->name) && - (!&equal($lastns,$domain))) { - &printerr("WARN", $rr->name - .": possible duplicate A record (glue of $lastns?)\n"); - } - } - } elsif ($rr->type eq "NS") { - $lastns=$rr->name; - print STDERR 'n' if $opt_d; - # check to see if object of NS is real - &checklamer($rr->name,$rr->nsdname) if ($main'opt_l); - # check for bogusnesses like NS->IP addr - if (&isipv4addr($rr->nsdname)) { - &printerr("BAD", $rr->name - ." NS ". $rr->nsdname .": Nameserver must be a hostname\n"); - } - ($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) { - &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"); + my $packed_ip = pack('C4', split(/\./, $rr->address)); + ($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($packed_ip, AF_INET); + + if (!$name && $rr->address !~ /^255/) { + printerr("WARN", $rr->name . " A " . $rr->address . ": no PTR record\n"); + } elsif ($opt_F && $name && !equal($name, $rr->name)) { + # Ignore localhost and similar special cases + 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"; } -# } + } + + if ($main::opt_a) { + # Duplicate glue record detection + if (!$glues{$rr->address}) { + $glues{$rr->address} = $rr->name; + } elsif ($glues{$rr->address} eq $rr->name && !equal($lastns, $domain)) { + printerr("WARN", $rr->name . ": possible duplicate A record (glue of $lastns?)\n"); + } + } + + } elsif ($rr->type eq "NS") { + $lastns = $rr->name; + print STDERR 'n' if $opt_d; + + checklamer($rr->name, $rr->nsdname) if $main::opt_l; + + if (isipv4addr($rr->nsdname)) { + printerr("BAD", $rr->name . " NS " . $rr->nsdname . ": Nameserver must be a hostname\n"); + } + + ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->nsdname); + + 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 ($rr->type eq "MX") { print STDERR 'm' if $opt_d; - # check to see if object of mx is real - if (&isipv4addr($rr->exchange)) { - &printerr("BAD", $rr->name - ." MX ". $rr->exchange .": Mail exchange must be a hostname\n"); - } - ($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) { - &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"); - } -# } + + if (isipv4addr($rr->exchange)) { + printerr("BAD", $rr->name . " MX " . $rr->exchange . ": Mail exchange must be a hostname\n"); + } + + ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->exchange); + + 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 ($rr->type eq "CNAME") { print STDERR 'c' if $opt_d; - ($name, $aliases, $addrtype, $length, - @addrs)=gethostbyname($rr->cname); - if (&isipv4addr($rr->cname)) { - &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) { - &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) = gethostbyname($rr->cname); + + if (isipv4addr($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"); + } } } + print STDERR "\n" if $opt_d; close(FILE); } + # prints an error message, suppressing duplicates sub printerr { - my ($type, $err)=@_; - if ($errlist{$err}==undef) { - print "$type: $err"; - $num_error{$type}++; - print STDERR "!" if $opt_d; - $errlist{$err}=1; + my ($type, $err) = @_; + + unless (exists $errlist{$err}) { + print "$type: $err"; + $num_error{$type}++; + print STDERR "!" if $opt_d; + $errlist{$err} = 1; } else { - 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 # my brain to this program yet. sub byhostname { - @c = reverse(split(/\./,$a)); - @d = reverse(split(/\./,$b)); - for ($i=0;$i<=(($#c > $#d) ? $#c : $#d) ;$i++) { + my @c = reverse split(/\./, $a); + my @d = reverse split(/\./, $b); + + my $max = @c > @d ? $#c : $#d; + for my $i (0 .. $max) { next if $c[$i] eq $d[$i]; - return -1 if $c[$i] eq ""; - return 1 if $d[$i] eq ""; - if ($c[$i] eq int($c[$i])) { - # numeric + return -1 if !defined($c[$i]) || $c[$i] eq ""; + return 1 if !defined($d[$i]) || $d[$i] eq ""; + if ($c[$i] =~ /^\d+$/ && $d[$i] =~ /^\d+$/) { return $c[$i] <=> $d[$i]; - } - else { - # string + } else { return $c[$i] cmp $d[$i]; } } @@ -395,22 +387,24 @@ sub byhostname { } sub checklamer { - my ($zone,$nameserver)=@_; - my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN"); - my ($soa_req); - my ($res) = new Net::DNS::Resolver; + my ($zone, $nameserver) = @_; + + my $res = Net::DNS::Resolver->new; unless ($res->nameservers($nameserver)) { - &printerr("FAIL", "Cannot find address for nameserver: ". - $res->errorstring. "\n"); + printerr("FAIL", "Cannot find address for nameserver: " . $res->errorstring . "\n"); + return; } - $soa_req = $res->send($packet); - unless (defined($soa_req)) { - &printerr("FAIL", - "Cannot get SOA record for $zone from $nameserver (lame?): ". - $res->errorstring ."\n"); - return; + + 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; + } + + unless ($soa_req->header->aa) { + printerr("BAD", "$zone NS $nameserver: lame NS delegation\n"); } - &printerr("BAD", "$zone NS $nameserver: lame NS delegation\n") - unless ($soa_req->header->aa); - return; } +