#!/usr/bin/perl
## IBM_PROLOG_BEGIN_TAG 
## This is an automatically generated prolog. 
##  
## tcpip720 src/tcpip/usr/samples/tcpip/named-bootconf.pl 1.1 
##  
## Licensed Materials - Property of IBM 
##  
## Restricted Materials of IBM 
##  
## COPYRIGHT International Business Machines Corp. 1997 
## All Rights Reserved 
##  
## US Government Users Restricted Rights - Use, duplication or 
## disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
##  
## IBM_PROLOG_END_TAG 

## @(#)03      1.1  src/tcpip/usr/samples/tcpip/named-bootconf.pl, tcpnaming, tcpip720 6/4/97 11:57:53

## Copyright (c) 1996 by Internet Software Consortium
##
## Permission to use, copy, modify, and distribute this software for any
## purpose with or without fee is hereby granted, provided that the above
## copyright notice and this permission notice appear in all copies.
##
## THE SOFTWARE IS PROVIDED "AS IS" AND INTERNET SOFTWARE CONSORTIUM DISCLAIMS
## ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
## OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL INTERNET SOFTWARE
## CONSORTIUM BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
## DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
## PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
## ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
## SOFTWARE.

# This is a filter.  Input is a named.boot.  Output is a named.conf.

#
# This requires perl 5.0 or later.  Please, change the top line to point to
# the perl program on your ship.  Perl does not ship with base AIX.
#
# This perl script converts BIND 4 named.boot files to BIND 8 named.conf files.
#

$new_config = "";

$have_options = 0;
%options = ();
%options_comments = ();
@topology = ();
@bogus = ();
$bogus_comment = "";
@transfer_acl = ();
$transfer_comment = "";
$topology_comment = "";
$logging = "";

while(<>) {
    next if /^$/;

    # skip comment-only lines
    if (/^\s*;+(.*)$/) {
	$new_config .= "// $1\n";
	next;
    }

    # handle continued lines
    while (/\\$/) {
	s/\\$/ /;
        $_ .= <>;
    }
    
    chop;
    
    # deal with lines ending in a coment
    if (s/\s*;+(.*)$//) {
	$comment = "// $1";
    }

    ($directive, @rest) = split;

    $class = "";
    if ($directive =~ /^(.*)\/(.*)$/) {
	$directive = $1;
	$class = $2;
    }
    
    if ($directive eq "primary") {
	$zname = shift(@rest);
	&maybe_print_comment("","\n");
	$new_config .= "zone \"$zname\" ";
	if ($class ne "") {
	    $new_config .= "$class ";
	}
	$new_config .= "{\n";
	$new_config .= "\ttype master;\n";
	$filename = shift(@rest);
	$new_config .= "\tfile \"$filename\";\n";
	$new_config .= "};\n\n";
    } elsif ($directive eq "secondary") {
	if ($directive eq "secondary") {
	    $type = "slave";
	} else {
	    $type = "stub";
	}
	$zname = shift(@rest);
	&maybe_print_comment("","\n");
	$new_config .= "zone \"$zname\" ";
	if ($class ne "") {
	    $new_config .= "$class ";
	}
	$new_config .= "{\n";
	$new_config .= "\ttype $type;\n";
	$filename = pop(@rest);
	$new_config .= "\tfile \"$filename\";\n";
	$new_config .= "\tmasters {\n";
	foreach $master (@rest) {
	    $new_config .= "\t\t$master;\n";
	}
	$new_config .= "\t};\n";
	$new_config .= "};\n\n";
    } elsif ($directive eq "cache") {
    	$zname = shift(@rest);
	&maybe_print_comment("","\n");
	$new_config .= "zone \"$zname\" {\n";
	$new_config .= "\ttype hint;\n";
	$filename = shift(@rest);
	$new_config .= "\tfile \"$filename\";\n";
	$new_config .= "};\n\n";
    } elsif ($directive eq "directory") {
	$options{"directory"} = "\"$rest[0]\"";
	$options_comments{"directory"} = $comment;
	$have_options = 1;
    } elsif ($directive eq "check-names") {
	$type = shift(@rest);
	if ($type eq "primary") {
	    $type = "master";
	} elsif ($type eq "secondary") {
	    $type = "slave";
	}
	$action = shift(@rest);
	$options{"check-names $type"} = $action;
	$options_comments{"check-names $type"} = $comment;
	$have_options = 1;
    } elsif ($directive eq "forwarders") {
	$options{"forwarders"}="{\n";
	foreach $forwarder (@rest) {
	    $options{"forwarders"} .= "\t\t$forwarder;\n";
	}
	$options{"forwarders"} .= "\t}";
	$options_comments{"forwarders"} = $comment;
	$have_options = 1;
    } elsif ($directive eq "slave") {
	&handle_options("forward-only");
    } elsif ($directive eq "options") {
	&handle_options(@rest);
    } elsif ($directive eq "limit") {
	&handle_limit(@rest);
    } elsif ($directive eq "include") {
	$new_config .= 
	    "// make sure your include is still in the right place\n";
	$comment = "\t" . $comment;
	$new_config .= "include \"$rest[0]\";$comment\n\n";
    } elsif ($directive eq "xfrnets" || $directive eq "tcplist") {
	push(@transfer_acl, @rest);
	$transfer_comment = $comment;
	$have_options = 1;
    } elsif ($directive eq "sortlist") {
	$topology_comment = $comment;
	push(@topology, @rest);
    } elsif ($directive eq "bogusns") {
	$bogus_comment = $comment;
	push(@bogus, @rest);
    } elsif ($directive eq "max-fetch") {
	$options{"transfers-in"}=$rest[0];
	$options_comments{"transfers-in"}=$comment;
	$have_options = 1;
    } else {
	$new_config .= "// NOTE: unconverted directive '$directive @rest'\n\n";
    }
}

print "// generated by named-bootconf.pl\n\n";
if ($have_options) {
    print "options {\n";
    foreach $option (sort(keys(%options))) {
	print "\t$option $options{$option};";
	if ($options_comments{$option} ne "") {
	    print "\t$options_comments{$option}";
	}
	print "\n";
    }
    if (@transfer_acl > 0) {
	print "\tallow-transfer {\n";
	&print_maybe_masked("\t\t", @transfer_acl);
	print "\t};";
	if ($transfer_comment ne "") {
	    print "\t$transfer_comment";
	}
	print "\n";
    }
    print "};\n\n";
}
if ($logging ne "") {
    print "logging {\n$logging};\n\n";
}
if (@topology > 0) {
    print "// Note: the following will be supported in a future release.\n";
    print "/*\n";
    if ($topology_comment ne "") {
	print "$topology_comment\n";
    }
    print "host { any; } {\n\ttopology {\n";
    &print_maybe_masked("\t\t", @topology);
    print "\t};\n};\n";
    print "*/\n";
    print "\n";
}
if (@bogus > 0) {
    if ($bogus_comment ne "") {
	print "$bogus_comment\n";
    }
    foreach $elt (@bogus) {
	print "server $elt { bogus yes; };\n";
    }
    print "\n";
}
print $new_config;

exit 0;

sub maybe_print_comment {
    $prefix = shift;
    $suffix = shift;
    if ($comment ne "") {
	$new_config .= sprintf("%s%s%s", $prefix, $comment, $suffix);
    }
}

sub handle_options {
    foreach $option (@_) {
	if ($option eq "forward-only") {
	    $options{"forward"}="only";
	    $options_comments{"forward"}=$comment;
	    $have_options = 1;
	} elsif ($option eq "no-recursion") {
	    $options{"recursion"}="no";
	    $options_comments{"recursion"}=$comment;
	    $have_options = 1;
	} elsif ($option eq "no-fetch-glue") {
	    $options{"fetch-glue"}="no";
	    $options_comments{"fetch-glue"}=$comment;
	    $have_options = 1;
	} elsif ($option eq "fake-iquery") {
	    $options{"fake-iquery"}="yes";
	    $options_comments{"fake-iquery"}=$comment;
	    $have_options = 1;
	} elsif ($option eq "query-log") {
	    if ($comment ne "") {
		$logging .= "\t$comment\n";
	    }
	    $logging .= "\tcategory queries { default_syslog; };\n";
	} else {
	    $options{"// NOTE: unconverted option '$option'"}="";
	    $options_comments{"// NOTE: unconverted option '$option'"}=
		$comment;
	    $have_options = 1;
	}
    }
}

sub handle_limit {
    $limit = shift;
    if ($limit eq "datasize" || $limit eq "transfers-in"
	|| $limit eq "transfers-per-ns" || $limit eq "files") {
	$options{$limit}=$_[0];
	$options_comments{$limit}=$comment;
	$have_options = 1;
    } else {
	$options{"// NOTE: unconverted limit '$limit @_'"}="";
	$options_comments{"// NOTE: unconverted limit '$limit @_'"}=$comment;
	$have_options = 1;
    }
}

sub print_maybe_masked {
    # this assumes a contiguous netmask starting at the MSB
    $prefix = shift;
    foreach $elt (@_) {
	if ($elt =~ /^(.*)&(.*)$/) {
	    $address = $1;
	    $mask = $2;
	    ($m1,$m2,$m3,$m4) = split(/\./, $mask);
	    $mask_val = ($m1 << 24) + ($m2 << 16) +($m3 << 8) + $m4;
	    $zero_bits = 0;
	    while (($mask_val % 2) == 0) {
		$mask_val /= 2;
		$zero_bits++;
	    }
	    $mask_bits = 32 - $zero_bits;
	} else {
	    $address = $elt;
	    ($a1,$a2,$a3,$a4) = split(/\./, $address);
	    if ($a < 128) {
		$mask_bits = 8;
	    } elsif ($a < 192) {
		$mask_bits = 16;
	    } else {
		$mask_bits = 24;
	    }
	}
	
	print "$prefix$address";
	if ($mask_bits != 32) {
	    print "/$mask_bits";
	}
	print ";\n";
    }
}