#! /usr/bin/perl -w## $Header: /usr/src/local/bind/4.9/mkdb.pl,v 1.37 1993/09/08 00:00:31 vixie Exp $## from a hosts(5) database on standard input or argv,# build the .data and .zone files needed by named.boot## $Log: mkdb.pl,v $% Revision 1.37  1993/09/08  00:00:31  vixie% ckp%##++ BEGIN user servicable parts 01/02$Domain = 'pa.dec.com';$Zone = 'decpa';%DelegOctet = (	"16", 2,		# net 16 delegates at the second octet in pa	);$Debug = 4;#-- END user servicable parts 01/02$, = ' ';umask(022);chop($date = `/bin/date`);$Serial_File = 'version';$MX_File = 'mx_data';($Domain_Pat = "$Domain") =~ s/(\W)/\\$1/go;$Domain_Pat = "\\.$Domain_Pat\$";&Load_MX_Data();&Update_Serial_Number();&Update_Zone_Serials();	&Init_Zone_Datafiles();&Churn();&Close_Zone_Datafiles();exit 0;sub Find_Deleg {	local(@a) = @_;	local($x, $deleg);	for ($x = 3;  $x >= 0;  $x--) {		$deleg = $DelegOctet{join('.', @a[0..$x])};		last if $deleg;	}	if ($x < 0) {		$deleg = 3;	# default for unspecified nets	}	@a = (	join('.', @a[0..($deleg-1)]),		join('.', reverse(@a[$deleg..3]))	);	print "Find_Deleg(@_) -> (@a)\n"		if $Debug & 0x01;	return @a;}sub Write_RR {	local($fh, $name, $type, $data) = @_;	print "Write_RR(@_)\n"				if $Debug & 0x02;	if ($name eq $Write_RR'last_name{$fh}) {		$name = '';	} else {		$Write_RR'last_name{$fh} = $name;	}	printf $fh "%-30s in %-5s %s\n", $name, $type, $data;}sub Load_MX_Data {	open(f, "<$MX_File") || die "$MX_File: $!";	local($name) = ('');	while (<f>) {		chop;		s/\#.*$//;	# delete inline comments like this one		s/\s+$//;	# delete trailing whitespace		next unless length($_);		if (/^\s+/) {			$_ = $';	# default name		} elsif (/\s+/) {			$name = $`;	# specified name			$_ = $';		} else {			warn "$MX_File:$.: bad format ($_)\n";			next;		}		($cost, $target, @rest) = split;		if ($cost <= 0 || $cost > 32767) {			warn "$MX_File:$.: bad MX cost ($cost)\n";			next;		}		if ($#rest >= $[) {			warn "$MX_File:$.: extra tokens ($_)\n";			next;		}		$MX_Data{$name} = '' unless defined($MX_Data{$name});		$MX_Data{$name} .= "$cost $target\n";	}	close(f);}sub Write_MX_Data {	local($zone, $name) = @_;	local($n, $d, $_);	print "Write_MX_Data(@_)\n"			if $Debug & 0x04;	foreach $n ($name, "*") {		foreach $d (split(/\n/, $MX_Data{$n})) {			&Write_RR($zone, $name, 'mx', $d);		}	}}sub Update_Serial_Number {	local(*f);	if (open(f, "<$Serial_File") && ($Serial_No = <f>)) {		close(f);	} else {		$Serial_No = 0;	}	$Serial_No++;	open(f, ">$Serial_File") || die "$Serial_File: $!";	print f "$Serial_No\n";	close(f);	print "*** New serial number is $Serial_No\n";}sub Update_Zone_Serials {	local(*f, $zonefile, $zone);	foreach $zonefile (<*.zone>) {		$zone = $zonefile;		$zone =~ s/\.zone$//;		$Zones{$zone}++ unless ($zone eq $Zone);		print "*** updating zone file '$zonefile'\n";		open(f, "<$zonefile") || die "$zonefile: $!";		@f = <f>;		open(f, ">$zonefile.NEW") || die "$zonefile.NEW: $!";		foreach (@f) {			$_ = $`.$Serial_No.$1."\n" if (/\d+(\s+\;Serial)/);			print f;		}		close(f) || die "$zonefile.NEW: $!";	}	print "*** Zone file serial numbers updated\n";}sub Init_Zone_Datafiles {	#	# our name servers are considered authoritative for the following	# zones of in-addr.arpa.  we create a .data file for each here.  None	# of them have SOA's since we expect them to be $INCLUDE'd by .zone	# files.	#	local($zone);	foreach $zone (sort(keys(%Zones))) {		print "*** Init'ing zone ".$zone."\n";		open($zone, ">$zone.data.NEW") || die "$zone.data.NEW: $!";		$rzone = join('.', reverse(split(/\./, $zone)))		       . '.in-addr.arpa.';		print $zone "; $zone.data ($zone - $rzone) $date\n";		print $zone '$ORIGIN '.$rzone."\n";	}	# the main host->addr file has no origin statement in it since	# its name is not mechanically translatable to its zone.	open($Zone, ">$Zone.data.NEW") || die "$Zone.data.NEW: $!";	&Write_MX_Data($Zone, "@");}sub Close_Zone_Datafiles {	foreach ($Zone, keys(%Zones)) {		close($_) || die "$_.data.NEW: $!";		rename("$_.data", "$_.data.BAK");		rename("$_.data.NEW", "$_.data") || die "rename1 ($_): $!";		rename("$_.zone", "$_.zone.BAK");		rename("$_.zone.NEW", "$_.zone") || die "rename2 ($_): $!";	}}sub Churn {    print "*** Churning\n";host:    while (<>) {	chop;	# capture and convert comments	if (/^\s*\#/) {		$_ = ';' . $';		print $Zone "$_\n";		last host if (/BELOW HERE NOT REGISTERED WITH DOMAIN SERVER/);		next host;	}	s/\s*\#.*$//;	# parse line, skip it if addr doesn't have four components	y/A-Z/a-z/;	($a, $name, @aliases) = split;	next host if (4 != (@a = split(/\./, $a)));	$name =~ s/$Domain_Pat//o;	#	# names that still have dots need to be qualified since they	# aren't local.	#	# only local names get MX RR's generated for them.	#	if ($name =~ /\./) {		$fullname = $name . '.';	} else {		&Write_RR($Zone, $name, 'a', $a);		#		# do not generate mx rr's for network or broadcast a rr's		# or for loopback addresses		#		if ($a[0] != 127 && $a[3] != 0 && $a[3] != 255) {			&Write_RR($Zone, $name, 'mx', "0 $name");			&Write_MX_Data($Zone, $name);		}		$fullname = $name . ".$Domain.";	}	($zone, $ptr) = &Find_Deleg(@a);	#	# if this is a zone we support, write out a PTR for it	#	if ($Zones{$zone}) {		&Write_RR($zone, $ptr, 'ptr', $fullname);	}	#	# iterate over the aliases, if any, and generate CNAMEs and PTRs.	#	foreach (@aliases) {		s/$Domain_Pat//o;		# aliases that are the same as the basename aren't useful		next if ($_ eq $name);		# CNAME makes sense only for local names		if (! /\./) {			$maybedot = '.' if ($name =~ /\./);			&Write_RR($Zone, $_, 'cname', $name.$maybedot);		}		# PTR makes sense only for zones we support (NOTE: $_ smashed)		if ($Zones{$zone}) {			$_ .= ".$Domain" unless /\./;			&Write_RR($zone, $ptr, 'ptr', "$_.");		}	}    }}