#! /usr/local/bin/perl
#
#  rrc - resource records checker
#
#  invoke as:
#	rrc [-l msglevel]
#
#  Copyright (C) 1992, 1993 PUUG - Grupo Portugues de Utilizadores
#				   do Sistema UNIX
#	         1992, 1993 FCCN - Fundacao para o Desenvolvimento dos Meios 
#			     	   Nacionais de Calculo Cientifico 	
#
#  Authors: Jorge Frazao de Oliveira <frazao@puug.pt>
#	    Artur Romao <artur@dns.pt>
#
#  This file is part of the DDT package, Version 2.0.
#
#  Permission to use, copy, modify, and distribute this software and its 
#  documentation for any purpose and without any fee is hereby granted, 
#  provided that the above copyright notice appear in all copies.  Neither 
#  PUUG nor FCCN make any representations about the suitability of this
#  software for any purpose.  It is provided "as is" without express or 
#  implied warranty.


# =()<push(@INC, "@<LIBDIR>@");>()=
push(@INC, "/usr/local/lib/ddt/cmd");

require "ddt.pl";


while (<STDIN>) {
	next if /^;\s+Ignoring info/;	# if commented lines are not 
					# of this form
	s/^; //;				# check them too

	chop;				# strip record separator
	@Field = split(/\s+/, $_);	# break the input line

	if (/^\$ORIGIN/) {
		$Origin = $Field[2];	# set to a different origin
	
		next;
	}

    	if (/^[*\.\-0-9A-Za-z]+/) { 
		$LineName = 1;

		$Name = &make_name($Field[1], $Origin);
	}

    	if (/\tIN\tSOA\t/) {
		$Zone = &tolower($Name);

		if ($Line[$#Line] eq '(') {
			&SOA_RR($Zone, $Field[$#Field - 2]); 

       			<STDIN>;	# skip the line defining the timers
		}
		else {
			&SOA_RR($Zone, $Field[$#Field - 7]);
		}
	}
	elsif (/\tIN\tNS\t/) {
		&NS_RR($Zone, $Name, $Field[$#Field]);
	}
    	elsif (/\tIN\tWKS\t*([*\.\-0-9A-Za-z]+)/) {
		&WKS_RR($Zone, $Name, $1);
    	}
	elsif (/\tIN\tCNAME\t/) {
		&CNAME_RR($Zone, $Name, $Field[$#Field]);
    	}
    	elsif (/\tIN\tA\t/) {
		&A_RR($Zone, $Name, $Field[$#Field]);
    	}
    	elsif (/\tIN\tPTR\t/) {
		&PTR_RR($Zone, $Name, $Field[$#Field]);
    	}
    	elsif (/\tIN\tMX\t/) {
		&MX_RR($Zone, $Name, $Field[$#Field]);
    	}
    	elsif ($LineName) {	# it only makes sense to check on these if
		$LineName = 0;	# they're related to a new name, or else
				# "someone" has already done it
		if(/\tIN\tHINFO\t/) {
			&HINFO_RR($Zone, $Name);
    		}
	    	elsif (/\tIN\tTXT\t/) {
			&TXT_RR($Zone, $Name);
    		}
	}
}

&check_RR();

exit(0);


sub perror_notation {
    	local($name) = @_;

    	if ($Level >= 3) {
		print "$Lpad[3]Hostname $name should be in domain notation";
    	}
}


sub perror_no_data {
    	local($name, $zone) = @_;

       	if (&in_THIS_zone($name, $zone)) {
		if (Level >= 2) {
	               	print "$Lpad[2]No A/CNAME records found for $name";
        	}
	}
        elsif ($Level >= 4) {
		print "$Lpad[4]No A/CNAME records found for $name [Can't verify it]";
        }
}


sub perror_trailing_dot {
    	local($name) = @_;

    	if ($Level >= 3) {
		print "$Lpad[3]Perhaps name without a trailing dot: $name"; 
    	}
}


sub perror_address_mismatch {    
	local($address, $name, $zone) = @_;

    	if (&in_THIS_zone($name, $zone)) {
        	if ($Level >= 3) {
            		print "$Lpad[3]$address/$name mismatch in a WKS record";
        	}
    	}
    	elsif ($Level >= 4) {
	    	print "$Lpad[4]$address/$name mismatch in a WKS record [Can't verify it]";
        }
}


sub perror_subzone_ns {
    	local($zone) = @_;

    	if ($Level >= 4) {
		print "$Lpad[4]Can't verify if NS RRs for $zone are correct";
    	}
}


sub perror_missing_ns {
    	local($server, $zone) = @_;

    	if ($Level >= 1) {
		print "$Lpad[1]$server is not a valid name server for $zone"; 
    	}
}


sub perror_extra_ns {
        local($server, $zone) = @_;
	local(@label, $upzone);

        if ($Level >= 2) {
		@label = split(/\./, $zone);
		shift(@label);
		$upzone = join(".", @label) . ".";

		print "$Lpad[2]$server is not defined as name server for $zone in $upzone";
    	}
}


sub perror_reserved_name_error {
    	local($host, $zone) = @_;

    	if ($Level >= 1) {
        	print "$Lpad[1]This name may introduce a severe problem: $host"; 
    	}
}


sub perror_reserved_name_warn {
    	local($host) = @_;

    	if ($Level >= 3) {
        	print "$Lpad[3]You should avoid the use of this reserved name: $host";
    	}
}


sub perror_mult_ip {
	local($address) = @_;

	if ($Level >= 3) {
		$names = $Names{$address};
		$names =~ s/$LISTsep/$LISTsep /g;

		print "$Lpad[3]There are several hosts with address $address: $names";
	}
}


sub perror_mult_revip {
	local($address) = @_;

	if ($Level >= 3) {
		$names = $RevNames{$address};
		$names =~ s/$LISTsep/$LISTsep /g;

		print "$Lpad[3]There are several names mapped into $address: $names";
	}
}


sub perror_alias_chain {
	local($alias, $name) = @_;

	if ($Level >= 4) {
		print "$Lpad[4]Alias $alias points to another alias: $name";
	}
}


sub perror_alias {
	local($alias) = @_;

	if ($Level >= 3) {
		print "$Lpad[3]Alias $alias used where a canonical name should appear";
	}
}

#
# check if this is a "missing trailing dot" problem
#
sub missing_trailing_dot {
        local($name, $zone) = @_;
	local($s) = "[.]";

        $zone = "." . $zone;
    	$zone =~ s/$s/[.]/g;

    	if (($name =~ $zone) && (length($`) + length($&) != length($name))) {
            	&perror_trailing_dot($name);
    	}
}


#
# is there anything leading us to this $name?
#
sub has_data {
        local($name) = @_;

        return defined $Addresses{$name} || $IsAlias{$name};
}


#
# a $name in dot-quad notation!!
#
sub internet_address_format {
    	local($name) = @_;
    
	return $name =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\.$/;
}


#
# $name is one of the names one shouldn't use in RR's
#
sub is_reserved_name {
    	local($name) = @_;

    	return $name =~ /^localhost/ || 
               $name =~ /^loopback/  || 
               $name =~ /^127[.]0[.]0[.]1/ ||
	       $name =~ /^1.0.0.127.in-addr.arpa/;
}


#
# in this case the reserved-name problem can be really serious...
#
sub reserved_name_error {
    	local($name, $zone) = @_;

     	if (&is_reserved_name($name) && !$ResNameError{$name, $zone}++) {
       		&perror_reserved_name_error($name);
    	}
}


#
# ... but here we only warn about it
#
sub reserved_name_warn {
    	local($host, $zone) = @_;
    
	if (&is_reserved_name($host) && !$ResNameWarn{$name, $zone}++) {
		&perror_reserved_name_warn($host);
    	}
}


#
# $address is really one of $name's addresses
#
sub ip_address_match {
	local($address, $name) = @_;

	return &in($address, $Addresses{$name}, $LISTsep);
}


#
# fetch the name servers for $zone
#
sub get_zone_ns {
        local($zone) = @_;
        local(@myNS, $name, $server, $NSlist);

	# get the NS as defined in $zone...
        @myNS = split($LISTsep, $NS{$zone});

	while (@myNS) {
        	($name, $server) = split($ELEMsep1, shift(@myNS));

		if ($name eq $zone) {	# ... but check only those 
					# for $zone itself
			$NSlist = &add_list($NSlist,$server);
		}
	}
        return $NSlist;
}


#
# warn about a CNAME pointing to a CNAME
#
sub check_alias_chain {
	local($alias, $name) = @_;

	if ($IsAlias{$name}) {
		&perror_alias_chain($alias, $name);
	}
}


#
# warn about aa alias used where it is advisable to have a canonical
# name, i.e., everywhere except on the left side of a CNAME RR
#
sub check_alias {
	local($name, $zone) = @_;

	if ($IsAlias{$name} && !$AliasError{$name,  $zone}++) {
		&perror_alias($name);
	}
}


#
# see if there are several names having this $address
#
sub check_unique_ip {
	local($address, $zone) = @_;
	local(@namelist);

	if (!$MultIPError{$address, $zone}++) {	# report this only once
		@namelist = split($LISTsep, $Names{$address});

		if ($#namelist > 1) {
			&perror_mult_ip($address);
		}
	}			
}


#
# see if the same PTR RR is used to map more than one name
#

sub check_unique_revip {
	local($address, $zone) = @_;
        local(@namelist);

        if (!$MultRevIPError{$address, $zone}) {   # report this only once
                $MultRevIPError{$address, $zone} = 1;

                @namelist = split($LISTsep, $RevNames{$address});

                if ($#namelist > 1) {
                        &perror_mult_revip($address);
                }
        }

}

#
# look for some problems with this hostname
#
sub check_hostname {
    	local($name, $zone) = @_;

    	if (&internet_address_format($name)) {
		&perror_notation($name);
		return 0;
    	}
    	elsif (!&has_data($name) && !$NoData{$name, $zone}++) {	
	    	&perror_no_data($name, $zone);		# report this only once
	    	return 0;
	}
    
    	return 1;
}


#
# check delegation information for inconsistensies
#
sub check_delegate {
	local(*subzones, $zone) = @_;
	local($subzn, $zonens, $myzonens, @myservers, @realservers);
	local($svr, $server);

    	foreach $subzn (keys %subzones) {
		if (defined $NS{$subzn}) {
			$myzonens  = $subzones{$subzn};
	    		$zonens    = &get_zone_ns($subzn);

			# the NS list for $subzn, as seen by $zone
	    		@myservers = split($LISTsep, $myzonens);

			while ($server = shift(@myservers)) {
				if (!&in($server, $zonens, $LISTsep)) {
		    			&perror_missing_ns($server, $subzn);
				}
	    		}

			# the NS list for $subzn, as seen by $subzn
	    		@realservers = split($LISTsep, $zonens);

			while ($server = shift(@realservers)) {
				if (!&in($server, $myzonens, $LISTsep)) {
		    			&perror_extra_ns($server, $subzn);
				}
	    		}
		}
		else {
	    		&perror_subzone_ns($subzn);
		}
    	}
}


#
# take a look at all those RR's and report what's wrong woth them
#
sub check_RR {
	local($zone);
	local(@SOAlist, @NSlist, @CNAMElist, @Alist);
	local(@WKSlist, @HINFOlist, @TXTlist, @MXlist);

    	foreach $zone (keys %SOA) {
		print "\n\n ###", &toupper($zone), "###\n";

		@SOAlist = $SOA{$zone};
		&check_SOA($zone, *SOAlist);
		undef %SOAlist;
	
		@NSlist = split($LISTsep, $NS{$zone});
		&check_NS($zone, *NSlist);
		undef %NSlist;
	
		@CNAMElist = split($LISTsep, $CNAME{$zone});
		&check_CNAME($zone, *CNAMElist);
		undef %CNAMElist;

		@Alist = split($LISTsep, $A{$zone});
		&check_A($zone, *Alist);
		undef %Alist;

		@PTRlist = split($LISTsep, $PTR{$zone});
		&check_PTR($zone, *PTRlist);
		undef %PTRlist;

		@WKSlist = split($LISTsep, $WKS{$zone});
		&check_WKS($zone, *WKSlist);
		undef %WKSlist;

		@HINFOlist = split($LISTsep, $HINFO{$zone});
		&check_HINFO($zone, *HINFOlist);
		undef %HINFOlist;

		@TXTlist = split($LISTsep, $TXT{$zone});
		&check_TXT($zone, *TXTlist);
		undef %TXTlist;

		@MXlist = split($LISTsep, $MX{$zone});
		&check_MX($zone, *MXlist);
		undef %MXlist;
    	}
}


sub check_SOA {
    	local($zone, *SOAlist) = @_;
	local($origin);

	while ($origin = shift(@SOAlist)) {
		&missing_trailing_dot($origin, $zone);
    		&reserved_name_error($origin, $zone);
    		&check_hostname($origin, $zone);
		&check_alias($origin, $zone);
	}
}


sub check_NS {
    	local($zone, *NSlist) = @_;
	local($name, $server, @subzones);

	undef %subzones;

	while (@NSlist) {
		($name, $server) = split($ELEMsep1, shift(@NSlist));

		&missing_trailing_dot($name, $zone);
		&reserved_name_warn($name, $zone);

		&missing_trailing_dot($server, $zone);
		&reserved_name_error($server, $zone);
		&check_hostname($server, $zone);
		&check_alias($server, $zone);

		# create an NS list for each of our sub-zones, 
		# to check on their consistency later
		if ($name ne $zone) {
	    		$subzones{$name} = &add_list($subzones{$name}, $server);
		}
   	}

	&check_delegate(*subzones, $zone);
}


sub check_CNAME {
    	local($zone, *CNAMElist) = @_;
	local($alias, $name);

	while (@CNAMElist) {
		($alias, $name) = split($ELEMsep1, shift(@CNAMElist));

		&missing_trailing_dot($alias, $zone);
		&reserved_name_warn($alias, $zone);

		&missing_trailing_dot($name, $zone);
		&reserved_name_warn($name, $zone);
		&check_hostname($name, $zone);
		&check_alias_chain($alias, $name);
    	}
}


sub check_A {
    	local($zone, *Alist) = @_;
	local($name);

	while (@Alist) {
		($name, $address) = split($ELEMsep1, shift(@Alist));

		&missing_trailing_dot($name, $zone);
		&check_alias($name, $zone);		

		&check_unique_ip($address, $zone);
    	}
}


sub check_PTR {
	local($zone, *PTRlist) = @_;
	local($address);

	while(@PTRlist) {
		($address, $name) = split($ELEMsep1, shift(@PTRlist));

		&check_unique_revip($address, $zone);

		&missing_trailing_dot($name, $zone);
		&check_alias($name, $zone);
	}
}

sub check_WKS {
    	local($zone, *WKSlist) = @_;
	local($name, $address);

	while (@WKSlist) {
		($name, $address) = split($ELEMsep1, shift(@WKSlist));
		
		&missing_trailing_dot($name, $zone);
		&reserved_name_warn($name, $zone);
		&check_alias($name, $zone);
		if (&check_hostname($name, $zone) &&
    		    !&ip_address_match($address, $name)) {
			&perror_address_mismatch($address, $name, $zone);
		}
    	}
}


sub check_HINFO {
    	local($zone, *HINFOlist) = @_;
	local($name);

	while ($name = shift(@HINFOlist)) {
		&missing_trailing_dot($name, $zone);
		&reserved_name_warn($name, $zone);
		&check_hostname($name, $zone);
		&check_alias($name, $zone);
    	}
}


sub check_MX {
    	local($zone, *MXlist) = @_;
	local($name, $pointer);

	while (@MXlist) {
		($name, $pointer) = split($ELEMsep1, shift(@MXlist));

		&missing_trailing_dot($name, $zone);
        	&reserved_name_warn($name, $zone);

        	&missing_trailing_dot($pointer, $zone);
        	&reserved_name_error($pointer, $zone);
        	&check_hostname($pointer, $zone);
    	}
}


sub check_TXT {
        local($zone, *TXTlist) = @_;
        local($name);

	while ($name = shift(@TXTlist)) {
                &missing_trailing_dot(shift(@TXTlist), $zone);
		&check_alias($name, $zone);
        }
}


sub SOA_RR {
    local($zone, $origin) = @_;

    $SOA{$zone} = &add_list($SOA{$zone}, &tolower($origin));
}


sub NS_RR {
	local($zone, $name, $server) = @_;


	$NS{$zone} = &add_list($NS{$zone}, join($ELEMsep1, &tolower($name), 
						&tolower($server)));
}


sub A_RR {
    	local($zone, $name, $address) = @_;

	$A{$zone}         = &add_list($A{$zone}, 
					join($ELEMsep1, $name, $address));

	$Addresses{$name} = &add_list($Addresses{$name}, $address);

	# don't save duplicates nor names for 127.0.0.1
	if (!&in($name, $Names{$address}, $LISTsep) && 
	    !&is_reserved_name($address, $zone)) {
		$Names{$address} = &add_list($Names{$address}, $name);
	}
}


sub PTR_RR {
	local($zone, $address, $name) = @_;

	$PTR{$zone} = &add_list($PTR{$zone}, join($ELEMsep1, $address, $name));

	# don't save duplicates nor names for 1.0.0.127.in-addr.arpa
	if (!&in($name, $RevNames{$address}, $LISTsep) &&
	    !&is_reserved_name($address, $zone)) {
		$RevNames{$address} = &add_list($RevNames{$address}, $name);
	}
}


sub CNAME_RR {
    	local($zone, $name, $cname) = @_;

	$CNAME{$zone} = &add_list($CNAME{$zone}, 
				  join($ELEMsep1, 
				       &tolower($name), &tolower($cname)));

	$IsAlias{$name}  = 1;
}


sub WKS_RR {
    	local($zone, $name, $address) = @_;

	$WKS{$zone} = &add_list($WKS{$zone}, 
		      join($ELEMsep1, &tolower($name), $address));
}


sub HINFO_RR {
        local($zone, $name) = @_,

        $HINFO{$zone} = &add_list($HINFO{$zone}, &tolower($name));
}


sub TXT_RR {
	local($zone, $name) = @_,

	$TXT{$zone} = &add_list($TXT{$zone}, &tolower($name));
}


sub MX_RR {
	local($zone, $name, $pointer) = @_;
	local($n);

	$MX{$zone} = &add_list($MX{$zone}, join ($ELEMsep1, $name, $pointer));
}
