#! @PERL@

# $Id: cvtzone.pl,v 1.1.1.1 2001/01/31 03:59:15 zarzycki Exp $

# updatehosts DNS maintenance package
# Copyright (C) 1998-1999  Smoot Carl-Mitchell
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
# 
# smoot@tic.com

# convert a zone file to updatehost format
# zone files can be generated by dig axfr command
# read input from stdin

require "getopts.pl";

Getopts("acd:hi:o:");
if ($opt_h || ! $opt_d || ! $opt_o) {
	print STDERR <<EOF;
usage cvtzone [-a] [-c] -d domain [-i IPprefix] -o directory
	-a - append to output files instead of overwriting
	-c - include comments from zone file
	-d - default domain for output
	-h - this help message
	-i - IP address prefix
	-o - directory to write output
EOF
	exit;
}

$directory = $opt_o if $opt_o;

$continue = 0;
$default_domain = $opt_d;
$default_domain .= "." if $default_domain !~ /\.$/;
$origin_domain = $default_domain;
$domain_suffix = $default_domain; chop($domain_suffix);	# Remove trailing dot.
$seen_soa = 0;

# check the domain suffix and prefix for leading or trailing dots
$domain_suffix = ".$domain_suffix" if $domain_suffix !~ /^\./;
$ip_prefix = $opt_i;
$ip_prefix .= "." if $ip_prefix && $ip_prefix !~ /\.$/;

# setup default FIELD headers
$main = "# DOMAIN $default_domain\n";
$main .= "#FIELDS GLOBAL null=X host no=. suffix=$domain_suffix ip ";
$main .= "no=. prefix=$ip_prefix " if $ip_prefix;
$main .= "ether hard os contact ptr ttl\n";

$cname = "# DOMAIN $default_domain\n";
$cname .= "#FIELDS host no=. suffix=$domain_suffix alias no=. suffix=$domain_suffix ttl\n";

$mx = "# DOMAIN $default_domain\n";
$mx .= "#FIELDS domain no=. suffix=$domain_suffix priority host no=. suffix=$domain_suffix ttl\n";

$ns = "# DOMAIN $default_domain\n";
$ns .= "#FIELDS domain no=. suffix=$domain_suffix server no=. suffix=$domain_suffix ttl\n";

$soa = "# DOMAIN $default_domain\n";
$soa .= "#FIELDS domain no=. suffix=$domain_suffix server no=. suffix=$domain_suffix contact no=. suffix=$domain_suffix refresh retry expire min checknames notify also_notify\n";

$txt = "# DOMAIN $default_domain\n";
$txt .= "#FIELDS domain no=. suffix=$domain_suffix txt ttl\n";


while (<>) {
	chomp;
	# ignore blank lines
	next if /^\s*$/;

	# save comments (lines starting with semicolons) iff "-c" option used
	if (/^\s*;/) {
		# replace semicolon with crosshatch
		s/\s*;(.*)/#$+/;
		$comment .= "$_\n" if $opt_c;
		next;
	}

	# strip any trailing comments
	s/;.*$//;

	# add blank line before block of comments, for readability
	$comment = "\n$comment" if $comment;
	# we'll add comment before next output record, into same file

	# process an $ORIGIN statement
	if (/^\$ORIGIN/) {
		s/\$ORIGIN //;
		$origin_domain = $_;
		next;
	}

	# continuation line processing - only on SOA records
	if ($continue) {
		# end of continuation lines
		if (/\s+\)/) {
			s/\s+\)//;
			$continue = 0;
		}
		# strip leading and trailing whitespace
		s/(^\s*)(.*)(\s*$)/ $2 /;
		$value .= $_;
	}
	else {
		# set the domain for each record
		s/^@/$origin_domain/ unless $continue;
		s/^\s/$current_domain / unless $continue;

		# parse the resource record line
		($domain, $ttl, $type, $value) = parse_rr($_);

		# fully qualify the domain
		$domain =  "$domain.$origin_domain" if $domain !~ /\.$/;

		# uppercase $type
		$type = "\U$type";

		$current_domain = $domain;
		# continuation lines
		if ($type eq "SOA" and $value =~ /\s+\(/) {
			$continue = 1;
			$value =~ s/\s+\(//;
			if ($value =~ /\s+\)/) {
				$value =~ s/\s+\)//;
				$continue = 0;
			}
		}

	}

	next if $continue;

	if ($type eq "SOA") {
		($server, $contact, $serial, $refresh, $retry, $expire, $min) = split(' ', $value);

		$seen_soa = 1;
		# need to interpret values, since they are in a readable format
		$refresh = cvttime($refresh);
		$retry = cvttime($retry);
		$expire = cvttime($expire);
		$min = cvttime($min);

		# fully-qualify any partially qualified domains and then strip
		# them to less the default_domain
		$domain = strip_domain($domain, $origin_domain, $default_domain);
		$server = strip_domain($server, $origin_domain, $default_domain);
		$contact = strip_domain($contact, $origin_domain, $default_domain);

		$soa .= "$comment"; $comment = "";
		$soa .= "$domain\t$server\t$contact $refresh $retry $expire $min warn yes\n";
		next;
	}

	if ($type eq "NS") {
		$domain = strip_domain($domain, $origin_domain, $default_domain);
		$value = strip_domain($value, $origin_domain, $default_domain);
		$ns .= "$comment"; $comment = "";
		$ns .= "$domain\t$value\n";
		next;
	}

	if ($type eq "A") {
		$domain = strip_domain($domain, $origin_domain, $default_domain);
		$value = strip_ip($value, $ip_prefix);
		$main .= "$comment"; $comment = "";
		$main .= "$domain\t$value\n";
		next;
	}

	if ($type eq "MX") {
		($priority, $mail_server) = split(/\s+/, $value);
		$domain = strip_domain($domain, $origin_domain, $default_domain);
		$mail_server = strip_domain($mail_server, $origin_domain, $default_domain);
		$mx .= "$comment"; $comment = "";
		$mx .= "$domain\t$priority\t$mail_server\n";
		next;
	}

	if ($type eq "CNAME") {
		$domain = strip_domain($domain, $origin_domain, $default_domain);
		$value = strip_domain($value, $origin_domain, $default_domain);
		$cname .= "$comment"; $comment = "";
		$cname .= "$value\t$domain\n";
		next;
	}

	if ($type eq "HINFO") {
		# split on doublequote-space-doublequote, then add doublequotes
		# back to end of $hard and beginning of $os
		($hard, $os) = split(/"\s+"/, $value);
		$hard = "$hard\"";
		$os = "\"$os";
		# insert hardware/OS information into last main record
		$main =~ s/\n(.*?)\n$/\n$+\tX\t$hard\t$os\n/;
		next;
	} 

	if ($type eq "TXT") {
		$domain = strip_domain($domain, $origin_domain, $default_domain);
		$value =~ s/"(.*?)"/$+/;
		$txt .= "$domain \"$value\"\n";
		next;
	}
}

$op = ">";
$op = ">>" if $opt_a;
# write all the file out to the directory
# only write the soa and ns files for in-addr.arpa domain
open(OUT, "$op $directory/soa") || die "cannot open $directory/soa\n";
print OUT $soa;
open(OUT, "$op $directory/ns") || die "cannot open $directory/ns\n";
print OUT $ns;
exit if $default_domain =~ /in-addr\.arpa\.$/;

open(OUT, "$op $directory/main") || die "cannot open $directory/main\n";
print OUT $main;
open(OUT, "$op $directory/mx") || die "cannot open $directory/mx\n";
print OUT $mx;
open(OUT, "$op $directory/cname") || die "cannot open $directory/cname\n";
print OUT $cname;
open(OUT, "$op $directory/txt") || die "cannot open $directory/txt\n";
print OUT $txt;

sub strip_domain {
	local($domain) = shift;
	local($origin_domain) = shift;
	local($default_domain) = shift;

	# fully-qualify the domain with the origin_domain
	if ($domain !~ /\.$/) {
		if ($origin_domain) {
			$domain .= ".$origin_domain";
		}
		else {
			$domain .= ".$default_domain";
		}
	}

	# now strip off the default domain
	$domain =~ s/\.$default_domain$//;

	return $domain;
}

sub strip_ip {
	local($ip) = shift;
	local($ip_prefix) = shift;

	$ip = ".$ip";
	$ip =~ s/^.$ip_prefix//;
	return $ip;
}

sub cvttime {
	local($input) = shift;

	# do nothing if all digits
	return $input if $input =~ /^[0-9][0-9]*$/;

	# parse the string
	$input = "\L$input\E";
	local(@chars) = split(//, $input);
	
	# string looks like xxwxxxdxxhxmxxs
	# convert to seconds
	local($output) = 0;
	local($value) = "";
	local($char);
	for $char (@chars) {
		if ($char =~ /[0-9]/) {
			$value .= $char;
			next;
		}
		if ($char eq "w") {
			$output += int($value)*60*60*24*7;
			$value = "";
			next;
		}
		if ($char eq "d") {
			$output += int($value)*60*60*24;
			$value = "";
			next;
		}
		if ($char eq "h") {
			$output += int($value)*60*60;
			$value = "";
			next;
		}
		if ($char eq "m") {
			$output += int($value)*60;
			$value = "";
			next;
		}
		if ($char eq "s") {
			$output += int($value);
			$value = "";
			next;
		}
	}
	return $output;
}

# parse a resource record
# the domain is always present
# TTL and IN may be absent and may be in any order
# domain IN TTL type value
# return domain ttl type value triple
sub parse_rr {
	local($_) = shift;

	my(@token) = split;

	my($domain) = $token[0];
	shift(@token);
	my($ttl) = "";
	my($value) = "";
	
	# get rid of the IN if present
	shift(@token) if $token[0] =~ /^IN$/i;

	# ttl value
	if ($token[0] =~ /^\d+$/) {
		$ttl = $token[0];
		shift(@token);
	}
		
	# get rid of the IN if present
	shift(@token) if $token[0] =~ /^IN$/i;

	$type = "\U$token[0]\E";
	shift(@token);

	$value = join(" ", @token);

	return($domain, $ttl, $type, $value);
}
