#!/bin/perl

$version_number = "0.10 [02-Nov-94]";

# This script was developed using Perl 4.036. It has also been tested
# with Perl 5.000 (one minor change was needed).


########################################################################
#                           MAKEZONES                                  #
########################################################################

# Copyright (c), University of Cambridge, 1993, 1994.
#
# The University retains the copyright and all other legal rights
# to this software and makes it available non-exclusively. All users
# must ensure that the software in all its derivations carries a
# copyright notice as above. No warranty is expressed or implied.

# This file is available for anonymous ftp from
#
# ftp.cus.cam.ac.uk:/pub/software/programs/DNS/makezones
#
# Enquires to Philip Hazel <ph10@cus.cam.ac.uk>.



########################################################################
# CONFIGURATION VARIABLES
#
# These are put at the top for ease of changing. See below for the full
# specification of the script.


# Makezones checks the characters used in the components of names. Different
# sites may have different local standards in this respect. The variable
# $name_pattern is used to contain a regular expression pattern that
# matches valid components of domain names. Change it to suit your
# requirements. Note that:
#
#  (a) The variable contains only the pattern characters, NOT the delimiting
#      slashes.
#  (b) This pattern is for one component only, so should not contain things
#      that match full stops (periods).
#  (c) The start and end of string metacharacters (^ and $) should not be
#      included; makezones uses this variable to build up a larger pattern
#      to match complete domain names, and it puts in ^ and $ itself.
#  (d) Because it is being constructed as a Perl string, any backslash
#      characters in the pattern must be doubled.

# This pattern specifies that names must start with a letter, contain only
# letters, digits, and hyphens, and not end with a hyphen.

$name_pattern = '[a-zA-Z]([a-zA-Z\\-\\d]*[a-zA-Z\\d]+)?';

# Possible variations:
#
# $name_pattern = '[a-zA-Z\\d]([a-zA-Z\\-\\d]*[a-zA-Z\\d]+)?';  # digit at start
# $name_pattern = '[a-z]([a-z\\-\\d]*[a-z\\d]+)?';              # all lower case
#
# Note that, in addition to this, "*" is permitted as the first component of
# names on MX records, to allow MX wildcarding. Names for PTR records must
# always consist of four numeric components; $name_pattern is not used. Also,
# names on NS records may consist of numeric components - this is necessary
# in order to specify devolved reverse subzones.


# In a large zone it is very easy to accidentally reuse a name by mistake,
# or as the result of a typo. Makezones checks for duplicate names on A
# and PTR records unless the following variable is set to zero. When checking
# is enabled, it is possible to specify in the source file that certain
# duplicates are to be permitted. See the description of the DUP pseudo-
# RR below. Implied duplicates (i.e. records with no name, that take the 
# name of their predecessor) do not cause errors.

$duplicate_name_check = 1;


# To disable the checking of new zone file lengths against the previous
# versions, set $opt_short = 1 here. This forces the -short option for
# all runs. If a previous version does not exist when a check is required,
# a warning is output, but makezones does not fail.

$opt_short = 0;


# If you want fields in WKS records to be checked against the contents
# of a file for validity, then set $services to the name of the file,
# and $grep to your favourite grep command. The values below will be
# typical. The program searches for the service name followed by a space
# or a tab at the start of a line. If you don't want this check, set
# $services to the null string.

$services = "/etc/services";
$grep = "/usr/bin/egrep";


# If you want makezones to output some commentary as it goes along,
# to let you know it is making some progress, then set the $chatty
# variable to 1.

$chatty = 1;



########################################################################
# UNIX DEPENDENCIES
#
# The Unix "date" command is used to obtain the current date and time
# in a particular format.
#
# Perl's "stat" function is used to obtain the lengths of files; this may
# differ for other operating systems.
#
# Anything else I've forgotten?



########################################################################
#
# Makezones is a perl script for processing a source file for a DNS zone
# and producing the relevant operational DNS zone files. It does a lot of
# checking to ensure that the data is not bad, and it also ensures that
# the forward and reverse zone information is in step.
#
# Makezones handles the updating of the serial number automatically. It
# does this by updating the SOURCE FILE before generating the zone files.
#                >>>>>      NB NB NB NB      <<<<<
# The source file therefore has to be writeable. Makezones insists that
# the format of the serial number be <year><month><day><version> and that
# the year be four digits long, so that this code will continue to work
# after then end of 1999.
#
# Makezones handles Class B and Class C networks, because those are the
# ones that are around here in Cambridge, UK. It would not be hard to
# extend it to handle a Class A if that were required.
#
# Because the file should normally be correct, makezones makes no attempt
# attempt to continue if it finds a serious error. It just reports it and
# stops. However, syntax errors in the general records don't prevent it
# going on to check further records, so you can get more than one error
# message in a run. However, if it finds too many errors it says so, and
# gives up. "Too many" is currently more than ten.
#
# The input file looks like a normal DNS zone file, with the addition of
# the following rules, which impose additional restrictions. Some of these
# rules are to make it easy for makezones; some of them impose conventions
# that we use in Cambridge which might not be liked elsewhere. The code is
# well commented, and should be easy to modify.
#
#   . The class field ("IN") and the type fields ("A", "CNAME", etc.) must
#     be specified in upper case, as must "TCP" and "UDP" in WKS records.
#
#   . With the exception of the SOA & WKS records, all records must be
#     complete on one line of input. That is, continuation is not supported
#     in general.
#
#   . The SOA record must be right at the start of the file (except for blank
#     and comment lines), and must be set up so that each numeric parameter is
#     on a separate line. For example:
#
#     @    IN    SOA    cus.cam.ac.uk. hostmaster.ucs.cam.ac.uk. (
#                             1993080601      ; Serial
#                             10800           ; Refresh 3 hours
#                             3600            ; Retry 1 hour
#                             604800          ; Expire after a week
#                             86400 )         ; Minimum ttl
#
#     Makezones insists that the serial number be in this date-derived form.
#     Note that the serial number begins with the full year number, not just
#     the last two digits. The SOA record is expected to have the "IN" class
#     field; subsequent records may omit it.
#
#   . The NS records for the zone must appear at the top of the file, just
#     after the SOA record. These will be copied into the forward and the
#     reverse zone files. That is, the default assumption is that the name-
#     servers are the same for the forward and reverse zones. These NS records
#     must NOT have anything in the name field. The copying stops on reaching
#     the first record with a name field or the first non-NS record.
#
#   . Makezones can also cope with the case where there are different NS
#     records for the different zones. If an NS record at the top of the
#     file contains text after the nameserver name, this is taken as a list
#     of zones to which this NS record applies. For example,
#
#            IN    NS    abcd.some.domain.   some.domain.  144.44.0.0
#
#     The reverse zones are identified by their IP network numbers. If there
#     are a lot of them, multiple instances of this special kind of qualified
#     NS record can be used.
#
#   . NS records must always refer to fully qualified names. Makezones checks
#     for the final dot, because it is so easy to overlook this.
#
#   . Comment lines are not normally copied into the working zone files. They
#     can, however, be forced into them by the following syntax:
#
#     ;F   copy this comment line (without the F) into the forward file
#     ;R   copy this comment line (without the R) into the reverse file(s)
#
#   . Comments that are attached to resource records are not copied over
#     into the zone files in most cases.
#
#   . All records except PTR records are normally copied to the forward file.
#     However, A records can be marked as "reverse only" by preceding them
#     with ">R " at the start. In this case, no A record is written to the
#     forward file, but a PTR record is constructed for the appropriate
#     reverse zone file. There should be exactly one space after the ">R";
#     three characters are removed from the start of the record. If ">R" is
#     followed by a tab, the tab is not removed (i.e. it acts as more than
#     one space).
#
#   . PTR records and A records are the only ones used when generating the
#     reverse zone files. "A" records can be marked "forwards only" by preced-
#     ing them with ">F " at the start. This suppresses generation of a PTR
#     record for the reverse zone. It does not, however, suppress the check
#     that the address is in one of the networks being handled (see next item
#     but one for external networks).
#
#   . When several IP addresses are associated with the same domain name,
#     multiple A records are required. Normally, the second and subsequent
#     ones should follow the first record, without a name of their own, thus
#     causing the previous name to be copied. If the same name is in fact
#     present on more than one A (or PTR) record, makezones' duplicate
#     check will pick it up and cause an error, unless (a) duplicate checking
#     has been entirely suppressed or (b) the name is listed in a DUP record.
#
#   . DUP records are something invented just for makezones; they are not
#     part of DNS zone files and do not cause anything to be written to the
#     output files. The format of a DUP record is:
#
#     domain-name      DUP
#
#     A DUP record tells makezones that its name is expected to appear on
#     more than one A or PTR record, and this is not an error. The DUP 
#     record can appear in the file anywhere before the second record with 
#     the given name. (Putting all the DUP records together near the top is
#     one way of keeping all this information in one place.)
#
#   . If more than one A record has the same IP address, there are four
#     possibilities:
#
#       (1) This is an error in the input.
#
#       (2) One name is considered "canonical" and reverse lookups on the
#           address should yield this name.
#
#       (3) Reverse lookups on the address should yield all of the names.
#
#       (4) Reverse lookups on the address should yield more than one (but not
#           all) of the names.
#
#     By default, makezones assumes case (1), because typos are really easy to
#     make when handling IP addresses. It therefore produces an error message
#     in cases such as this:
#
#       some.name       A  199.99.99.99
#       other.name      A  199.99.99.99
#
#     If case (2) applies, then all but one of the records must have the ">F "
#     flag, to ensure that only one PTR record is generated (for the canonical
#     name). Again, there must be exactly one space or a tab after ">F". For
#     example:
#
#       canon.name      A  199.99.99.99
#       >F other.name   A  199.99.99.99
#
#     If case (3) applies, then all the records, except (optionally) the
#     first, must have the ">M " flag, to tell makezones that multiple PTR
#     records are required. It is probably helpful to put the flag on the 
#     first record as well, as a reminder that other records exist, especially
#     if they are separated in the input file. For example:
#
#       >M some.name    A  199.99.99.99
#       >M other.name   A  199.99.99.99
#
#     Case (4) is just a mixture of cases (2) and (3), with some records having
#     the ">M " flag and some the ">F " flag.
#
#   . We want to be able to check that all IP addresses are in one of the
#     networks that we are processing for. However, occasionally a record must
#     specify an external network (glue records are the prime example). Such
#     records must be flagged by ">E " at their start to override the error
#     that would otherwise occur. (They naturally won't get into any reverse
#     zones.) The special local address 127.0.0.1 is recognized and treated as
#     though ">E " is always present. The ">E " flag can be used on WKS
#     records as well as on A records.
#
#   . The name given for PTR records must be a complete, reversed IP address
#     that corresponds to one of the reverse zones. The network portion of
#     the "name" is removed when generating the PTR record for the reverse
#     zone.
#
#   . The ">M " flag may be used with PTR records if multiple entries
#     for the same IP address are required (see the comments about cases of
#     more than one name for the same IP number above). If this is done,
#     and the name (i.e. the reversed IP address) is explicitly quoted on
#     the second or subsequent records, it must also be listed in a DUP
#     record, unless duplicate checking is disabled.
#
#   . Very few PTR records should ever be necessary, but PTR records have to
#     be used instead of A records flagged with ">R " ("reverse only") when
#     the name pointed to is not in the domain of the forward zone, because
#     of the following rule:
#
#   . The names on all records must not end with . as we conventionally
#     specify them as partial domains for the forward zone. This means that,
#     if you want a record with the name of the zone as its domain, you must
#     use the "@" notation, which is supported.
#
#   . Makezones assumes that names consist of letters and digits, and start
#     with a letter. You can, however, override this by enclosing a name
#     in quotes. For example:
#
#     "3cpu"   A     134.232.45.69
#
#     I didn't want to allow these through normally, as in my zone they are
#     more likely to be typos. You can change the rules for what characters
#     are allowed in names (without quoting) by editing the variable
#     $name_pattern (see under CONFIGURATION VARIABLES at the head of this
#     file).
#
#   . There are occasions when you want to ensure that a name is *not*
#     present in your zone, for example, if you are reserving it for some
#     specific future use and don't want it used for something else by
#     mistake. The RESERVE record, which is a facility local to makezones,
#     can be used for this. If a record such as
#
#     do-not-use-me   RESERVE
#
#     is encountered by makezones, it performs its normal duplicate checking
#     on the name as if it were an A record, but generates no output from 
#     this record.
#
#   . CNAME records must point to fully qualified names. Makezones checks
#     that if a name appears on a CNAME, it does not appear on any other
#     record.
#
#   . MX records must point to fully qualified names.
#
#
# Makezones is run by a command of the following form:
#
#   makezones [options] <source> <forward-zone> <forward-zone-file> \
#     [<reverse-zone-file>]*
#
# For example:
#
#   makezones  DBsource  cam.ac.uk  db.cam  db.131.111  db.192.153.213
#
# The source file is specified as the first argument. The second and third
# arguments specify the name of the zone and the file into which the records
# for that zone are to be written. The name is required so that fully
# qualified names can be generated in the reverse zone files. The remaining
# arguments specify the networks for which reverse zone files are to be
# written, and the corresponding files. There need not be any if there are
# no PTR or non-forwards-only A records in the source file. Each of these
# final arguments is the name of a zone file. The first part of the name can
# be anything you like - the only requirement is that the name must end with
# a valid Class B or Class C network number.
#
# [This combining of network number and zone file name is done for convenience.
# To change makezones so that the numbers and file names are given as separate
# arguments would not be difficult; the changes would affect only the sub-
# routine that unpicks the arguments.]
#
# It is intended that makezones will normally be run as part of a "make"
# sequence which will also install the files and reload the nameserver(s)
# after makezones has run successfully. Thus, the command to run it will
# normally be stored in a file and not typed each time.
#
# The output files are actually written to temporary files whose names are the
# same as the final ones with ".new" appended. If the processing succeeds,
# these files are renamed; if it fails, they are deleted.
#
# Normally no options are required. There is currently only one option:
#
#   -short   Used when a new zone file is more than 5% shorter than the
#            previous version. If not given, the processing will fail if
#            a new file is that much shorter. This guards against the case
#            of accidental loss of large portions of the source file. Setting
#            -short disables the length checking for all zones. You do not
#            need to set this option if the previous versions of the files 
#            do not exist, as in that case a warning is given, but makezones
#            continues. The script can be configured to default to -short; see
#            "configuration options" above.
#
# The input file must be writable. The first thing the script does is to update
# the serial number in the original file. This forms a permanent record and
# ensures that all the created zones have the same number. The form of the
# serial number must be <year><month><day><sequence>, as in the example SOA
# record shown above. The code will continue to work after December 31, 1999.
# If more than 99 updates are done in one day, the failure is soft in that a
# valid serial number is still generated, though it no longer contains that
# day's date.
#
#
# Written by Philip Hazel <ph10@cus.cam.ac.uk>
#   University Computing Service
#   Computer Laboratory
#   New Museums Site
#   Cambridge CB2 3QG
#   United Kingdom
#   +44 1223 334714
#
# Started: August 1993
# Running: September 1993
#
# Update history:
#   0.03   07-Sep-93  I'd forgotten to allow TTLs on SOA records.
#   0.04   08-Sep-93  Allow comments before the SOA record.
#                     In several places, " " appeared in calls to split(),
#                       where "\s" should have appeared.
#                     Allow non-standard names in quotes. This lets in
#                       names like "3cpu" and "*.something".
#                     Treat tabs after >F etc as multiple spaces.
#                     Allow the name "@"; replace by zone name + dot.
#                     Allow omission of class field except on the SOA record.
#                     Check WKS address is in known network unless >E given.
#                     Fail broadcast addresses.
#   0.05   09-Sep-93  Use $name_pattern to check names.
#                     Permit "*" as first name component on MX records.
#   0.06   10-Sep-93  Failed if trailing spaces followed 127.0.0.1
#   0.06a  22-Sep-93  Updated the specification comments.
#   0.07   05-Nov-93  Added support for RP records.
#                     Added conditional facility for zone NS records.
#   0.08   09-Sep-94  Added the ">M " flag to permit multiple PTR records.
#                     Incorporated duplicate name checking and the DUP
#                       pseudo-record, and merged the CNAME check into
#                       this code as well. Uses an associative array, which
#                       will be large for large zones, but no larger than
#                       the existing one already used for addresses.
#                     Don't fail if previous version of a zone file does
#                       not exist (for length checking). Just say so.
#                     Support comments on the ends of all records.
#   0.09   01-Nov-94  Added /o to the pattern matches involving $name_pattern.
#                     Added the RESERVE record.



##################################################
#            Print error message and die         #
##################################################

# Ensure any temporary files are removed first. If reading the main file,
# $nline will be set non-zero and the current line will be in $_.

sub give_up {
do remove_temps();
print "\n** Makezones: $_[0]\n";
if ($nline > 0)
  {
  print "   At line $nline of $source_file:\n";
  print "   $_";
  }
die "** Processing abandoned.\n\n";
}



##################################################
#       Print error message and continue         #
##################################################

# After too many errors, give up.

sub error {
print "\n** Makezones: $_[0]\n";
if ($nline > 0)
  {
  print "   At line $nline of $source_file:\n";
  print "   $_";
  }
if (++$errors > 10)
  {
  do remove_temps();
  die "\n** Makezones: too many errors - processing abandoned.\n\n";
  }
}



##################################################
#       Print line to all reverse zone files     #
##################################################

sub print_reverse {
local($i);
for ($i = 0; $i < $rzone_count; $i++)
  {
  local($handle) = "REVERSE$i";
  print $handle $_[0];
  }
}



##################################################
#            Unpick the argument list            #
##################################################

# Exit from the whole program on failure.

sub unpick_args {
$rzone_count = 0;

# Handle options

while ($#ARGV >= 0 && substr($ARGV[0], 0, 1) eq '-')
  {
  if ($ARGV[0] eq "-short")  { $opt_short = 1; }
  else { do give_up("unknown option \"$ARGV[0]\""); }
  shift ARGV;
  }

# Now we should be left with at least four arguments

do give_up("at least three arguments are needed") if $#ARGV < 2;

# The first argument is the source file

$source_file = $ARGV[0]; shift ARGV;

# The second argument is the zone name; remove the trailing dot
# if present.

$zone_name = $ARGV[0]; shift ARGV;
chop($zone_name) if (substr($zone_name, -1, 1) eq ".");

# The third argument is the forwards zone file

$forward_file = $ARGV[0]; shift ARGV;

# We now have zero or more reverse zone files

while ($#ARGV >= 0)
  {
  local($rzone) = $ARGV[0]; shift ARGV;
  $rzone_file[$rzone_count] = $rzone;

  # Check explicitly for a class B or a class C number. I couldn't
  # find a cunning way of writing a single regular expression that
  # handled this. Anyway, we need to differentiate in order to check
  # the values.

  local($a,$b,$c) = $rzone =~ /^.*\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;

  if ("$a" eq "")
    {
    ($a,$b) = $rzone =~ /^.*\.(\d{1,3})\.(\d{1,3})$/;
    do give_up("\"$rzone\" does not end with a class B or C ".
      "network number") if $a eq "";
    do give_up("bad class B network $a.$b") if ($a < 128 || $a > 191);
    $rzone_number[$rzone_count++] = ($a << 24) | ($b << 16);
    }
  else
    {
    do give_up("bad class C network $a.$b.$c")
      if ($a < 192 || $a > 223);
    $rzone_number[$rzone_count++] = ($a << 24) | ($b << 16) | ($c << 8);
    }
  }
}



##################################################
#         Verify what we are going to do         #
##################################################

sub verify {
print "\nMakezones $version_number\n";
print "Generating DNS zone files for $zone_name from $source_file.\n";
print "  Forward zone file:  $forward_file\n";
printf "  Reverse zone file%s ", ($rzone_count == 1)? ": " : "s:";

if ($rzone_count > 0)
  {
  for ($i = 0; $i < $rzone_count; $i++)
    {
    print " "x22 if $i != 0;
    print "$rzone_file[$i]\n";
    }
  }
else { print "<none>\n"; }
}



##################################################
#           Update the serial number             #
##################################################

# This function also checks out the format of the SOA
# record at the top of the file. We require it to be split
# so that every field is on a different line.

sub update_serial {
local($i);
print "\nUpdating the serial number in the source file...\n" if $chatty;
open(SOURCE, "+<$source_file") ||
  do give_up("unable to open $source_file for read/write (to update serial)");

# Check out the first line as the start of the SOA data. Skip any
# prior comments, counting them so that we know how many lines to
# copy when copying the SOA data.

for (;;)
  {
  $_ = <SOURCE>;
  last if (!/^\s*$/ && !/^\s*;/);
  $soa_count++;
  }

local($host,$hostmaster);
local($at,$rest) = split(/\s+/, $_, 2);
if ($rest =~ /^\d/)
  {
  ($ttl,$host,$hostmaster) =
    $rest =~ /^(\d+)\s+IN\s+SOA\s+(\S+)\s+(\S+)\s*\($/;
  }
else
  {
  ($host,$hostmaster) = $rest =~ /^IN\s+SOA\s+(\S+)\s+(\S+)\s*\($/;
  }

do give_up("malformed SOA record")
  if ($at ne "@" || $host eq "" || $hostmaster eq "");

# Remember where to write the second line, read it, and fish
# out the serial number.

local($pos) = tell SOURCE;
$_ = <SOURCE>;
local($indent,$value) = /^(\s+)(\d{10})(\s*;.*|)$/;
do give_up("malformed serial number line (line 2 of SOA)") if ($value eq "");

# Check out the remaining lines of the SOA record

for ($i = 3; $i <= 6; $i++)
  {
  $_ = <SOURCE>;
  local($check) = ($i == 6)? /^\s+(\d+)\s*\)(\s*;.*|)$/ : /^\s+(\d+)(\s*;.*|)$/;
  do give_up("line $i of the SOA record is malformed") if ($check eq "");
  }

# Calculate the serial number for the first update of
# today, allowing for the impending millenium.

local($today_serial) = `date +20%y%m%d01`;
$today_serial -= 100000000 if (substr($today_serial, 2, 2) > 90);

# If the existing serial number is already >= today's
# start, increment it by one. Otherwise use today's start.

$value = ($value >= $today_serial)? $value+1 : $today_serial;

# Re-write the start of the second record with the new serial number.

seek(SOURCE, $pos, 0);
print SOURCE "$indent$value";
close SOURCE;
}





##################################################
#          Handle comment lines                  #
##################################################

sub handle_comment{
if (/^;F /)
  {
  printf FORWARD "; %s", substr($_, 3);
  }
elsif (/^;R /)
  {
  do print_reverse(join("", "; ", substr($_, 3)));
  }
}





##################################################
# Check final field is a fully-qualified name    #
##################################################

sub check_fqn{
do error("$_[1] record must point to a valid, fully qualified name.")
  if ($_[0] !~ /^[a-zA-Z][a-zA-Z\d\-]*(\.[a-zA-Z][a-zA-z\d\-]*)*\.$/)
}




##################################################
#              Handle non-comment records        #
##################################################

# The record is stored in $_ on entry. Do not alter this, since it is
# reflected after an error message. However, is is permitted to read a
# continuation record into it (as is done for WKS handling).

# Two associative arrays, %names and %addresses, are used for checking
# on the duplication of names and addresses. The check for CNAME and
# other data is handled by the same mechanism. The values used in the
# %names array are:
#
#   n == undef          the name has not yet been seen
#   n > 0               the name has appeared on one A (or PTR) record
#   $used_dup < n < 0   the name has appeared on a CNAME record
#   $used_dup           the name has appeared on a DUP record
#   $used_reserve       the name has appeared on a RESERVE record
#   $used_other         the name has appeared on any other DNS record
#
# The named values are all large negative numbers.
#
# An appearance on an A or PTR record overrides $user_other, and an appearance
# on a DUP record overrides a value > 0 and $used_other. The first
# entry to $names is set up when handling the SOA record. The values
# used for A, PTR and CNAME records are the line numbers where the first
# instance occurred (for use in error messages); to distinguish CNAME
# records, the line number is negated.


sub handle_record {
$forwards_only = $reverse_only = $external_net = $multiple = 0;

# If the record starts with ">E ", ">F ", ">M " or ">R " set flags for 
# later checks once the type of record is known, and remove these characters. 
# $forwards_only must always be set if $external_net is set. If ">E" etc. are 
# followed by a tab, this must be interpreted as if it were several spaces; 
# the right thing happens if the tab is not removed.

if (/^>E\s/)
  {
  $forwards_only = $external_net = 1;
  $rest = substr($_, (substr($_,2,1) eq " ")? 3:2);
  }
elsif (/^>F\s/)
  {
  $forwards_only = 1;
  $rest = substr($_, (substr($_,2,1) eq " ")? 3:2);
  }
elsif (/^>M\s/)
  {
  $multiple = 1;
  $rest = substr($_, (substr($_,2,1) eq " ")? 3:2);
  }
elsif (/^>R\s/)
  {
  $reverse_only = 1;
  $rest = substr($_, (substr($_,2,1) eq " ")? 3:2);
  }
else
  { $rest = $_; }

# Split the line into the first field (name) and the rest
# of the line. Name is null if the line starts with a space.
# In this case, set it to the value from the previous record,
# but set the printing name to blanks so it isn't output.
# We still use split() in this case, because it gets rid
# of the leading spaces on the remainder of the line.

($name,$rest) = split(/\s+/, $rest, 2);
if ($name eq "")
  {
  $name = $lastname;
  $printname = "  ";
  }
else
  {
  $printname = $name;
  $lastname = $name;
  }

# If $name is null, it means we have hit a record without a name
# field at the top of the file. In a zone file this would mean the
# name of the zone, but we don't allow this laxness.

if ($name eq "")
  {
  do error("missing name on the first record after initial SOA + NS records.");
  return;
  }

# Split off the TTL field, if present. It must consist entirely
# of digits.

if ($rest =~ /^\d/)
  {
  ($ttl,$rest) = split(/\s+/, $rest, 2);
  if ($ttl ne "" && $ttl !~ /^\d+$/)
    {
    do error("invalid TTL field (not all digits).");
    return;
    }
  }
else { $ttl = ""; }

# The class field may or may not be present. If not, the rule is to
# copy it from the previous record, but we support only the "IN"
# class anyway.

($class,$rest) = split(/\s+/, $rest, 2);
if ($class eq "IN")
  {
  ($type,$rest) = split(/\s+/, $rest, 2);
  }
else
  {
  $type = $class;
  $class = "";
  }

# Forward-only, reverse-only, external, and multiple flags may be
# specified only for A records, except that >E may be specified for
# WKS records, and >M for PTR records.

if ($multiple)
  {
  do error(">M may be specified only for type A or type PTR records.")
    if ($type ne "A" && $type ne "PTR");
  }
elsif ($external_net)
  {
  do error(">E may be specified only for type A or type WKS records.")
    if ($type ne "A" && $type ne "WKS");
  }
else
  {
  do error(">F and >R may be specified only for type A records.")
    if (($forwards_only || $reverse_only) && $type ne "A");
  }

# If the name's components all consists of digits, it it taken as a
# reversed IP address for inclusion in the reverse zone. Otherwise its
# components must match the pattern set in the $name_pattern variable.
# It may not end with a dot, as it is a subdomain name. Repeated names
# get checked twice, but this isn't a great overhead.
#
# To allow for exceptions to the general $name_pattern check, we permit
# names in double quotes. These are not checked at all.
#
# We must also allow the name "@" so that people can set up, for example,
# MX records for their entire zone, and we allow the first component of
# names on MX records to be "*".

if ($name eq "@")
  {
  $name = "$zone_name.";
  $printname = $name if (substr($printname, 0, 1) ne " ");
  }
elsif ($name =~ /^\*\./)
  {
  if ($name !~ /^\*\.$name_pattern(\.$name_pattern)*$/o)
    {
    do error("invalid wildcard name field\n".
             "** (or other components do not match name pattern).");
    $name = $lastname = "dummy";     # prevent subsequent errors
    }
  elsif ($type ne "MX")
    {
    do error("wildcard names are permitted only on MX records.");
    $name = $lastname = "dummy";     # prevent subsequent errors
    }
  }
elsif (substr($name, 0, 1) eq "\"" && substr($name, -1) eq "\"")
  {
  $name = substr($name, 1, length($name) - 2);
  $printname = $name if (substr($printname, 0, 1) ne " ");
  }
elsif ($name =~ /^\d{1,3}(\.\d{1,3})*$/)
  {
  # Just check that this is on a PTR or NS or DUP record - full checking 
  # of the name happens later for PTR & NS records.
  if ($type ne "PTR" && $type ne "NS" && $type ne "DUP")
    {
    do error("invalid name field for this type of record.");
    $name = $lastname = "dummy";     # prevent subsequent errors
    }
  }
elsif ($name !~ /^$name_pattern(\.$name_pattern)*$/o)
  {
  do error("invalid name field (components do not match name pattern).");
  $name = $lastname = "dummy";     # prevent subsequent errors
  }
  


# If the name on this record previously appeared on a RESERVE
# record, it is an error. Let processing continue, however, to
# detect other errors.

if ($names{"$name"} == $used_reserve)
  {
  do error("$name appeared on a previous RESERVE record.");
  }    


# If the name on this record, explicit or implied, previously
# appeared on a CNAME record, it is an error. Set the value back
# to nothing, to prevent multiple complaints.

if ($names{"$name"} < 0 && $names{"$name"} > $used_dup)
  {
  $temp = - $names{"$name"}; 
  do error("$name appears on a previous CNAME record (line $temp).");
  $names{"$name"} = ""; 
  }       
  
 


# Now we perform individual check which depend on the
# record's type field. We support only the following types:
# A, NS, CNAME, PTR, HINFO, MX, TXT, WKS, RP, and the special
# DUP (invented for makezones).

# For all except TXT, we must ignore trailing spaces and anything 
# following the first semicolon on the line, since that introduces 
# a comment. This is not quite so simple for TXT, because of the 
# quotes, so we handle TXT separately.


# Type TXT - arbitrary descriptive text, enclosed in double quotes

if ($type eq "TXT")
  {
  if ($rest !~ /^\".*\"\s*(;.*)?$/)
    {
    do error("malformed TXT record - must use double quotes.");
    }
  print FORWARD "$printname  $ttl  $class  TXT  $rest";
  $names{"$name"} = $used_other if $names{"$name"} == "";
  return;
  }


# Remove comments and trailing spaces for all other types. This also
# removes the trailing newline.

$rest =~ s/\s*(;.*)?$//;



# Type RESERVE - a locally invented feature to reserve a name for
# future use. Complain if the name has been previously used; otherwise
# set a value in the names array to reserve it.

if ($type eq "RESERVE")
  {
  do error("malformed RESERVE record (text after RESERVE).") if $rest !~ /^$/;
  if ($names{"$name"} ne "")
    {
    do error("reserved name $name previously used."); 
    }  
  else { $names{"$name"} = $used_reserve; }
  return;
  }  



# Type A - host address; the address must be in one of the networks
# being processed, unless it was flagged as an external network.

if ($type eq "A")
  {
  local($rzone);
  local($nn) = $names{"$name"}; 
  local($a,$b,$c,$d) =
    $rest =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
    
  if ($duplicate_name_check && $printname !~ /^\s*$/ && $nn > 0)
      {
      do error("unexpected duplicate name.\n".
        "** The first occurrence was in line $nn.");
      }
      
  $names{"$name"} = $nline if $nn == "" || $nn == $used_other;
     
  if ($a eq "")
    {
    do error("IP address is incomplete.");
    return;
    }

  if ($a > 255 || $b > 255 || $c > 255 || $d > 255)
    {
    do error("IP address contains component with value greater than 255.");
    return;
    }

  do error ("broadcast address not allowed.")
    if (($a >= 192 && $d == 255) || ($a < 192 && $c == 255 && $d == 255));

  # The loopback address is always treated as external

  $external_net = $forwards_only = 1 if ($rest =~ /^\s*127\.0\.0\.1\s*$/);

  # Check known network (& find network) unless external

  if (!$external_net)
    {
    local($net) = ($a << 24) | ($b << 16);
    $net += ($c << 8) if $a >= 192;

    for ($rzone = 0; $rzone < $rzone_count; $rzone++)
      { last if ($net == $rzone_number[$rzone]); }

    if ($rzone >= $rzone_count)
      {
      do error("IP address is not in a known network (use >E for externals).");
      return;
      }
    }

  # Output the A record to the forward file, unless reverse-only record.

  print FORWARD "$printname  $ttl  $class  A  $rest\n" if !$reverse_only;

  # If required, generate a PTR record for the reverse file. Check for
  # multiples, and complain unless the record is flagged as such.

  if (!$forwards_only)
    {
    $thisaddress = "$a.$b.$c.$d";
    if ($addresses{"$thisaddress"} != "" && !$multiple)
      {
      do error("duplicate IP address $thisaddress specified for a PTR record.\n".
        "** Use the >M flag if multiple PTR records are required.\n".
        "** The first occurrence was in line $addresses{$thisaddress}.");
      }
    else
      {
      local($handle) = "REVERSE$rzone";
      print $handle "$d";
      print $handle ".$c" if ($a < 192);
      print $handle "  $ttl  $class  PTR  $name";
      print $handle ".$zone_name." if (substr($name, -1, 1) ne ".");
      print $handle "\n";
      $addresses{"$thisaddress"} = $nline
        if $addresses{"$thisaddress"} == "";
      }
    }

  return;
  }



# Type CNAME - pointer to canonical name. We require the canonical
# name to be fully qualified. We also want to check that any name
# that is on a CNAME record does not also appear on any other records.
# This is done via the %names associative array. If there was a previous
# CNAME record, the error message has already been given (and the value
# set back to null to prevent another one).

if ($type eq "CNAME")
  {
  local ($nn) = $names{"$name"}; 
  do check_fqn($rest, "CNAME");
  if ($nn == "")
    {
    $names{"$name"} = - $nline;
    print FORWARD "$name  $ttl $class  CNAME  $rest\n";
    }
  else
    {
    if ($nn > $used_dup)
      {  
      $nn = - $nn if $nn < 0; 
      do error("$name appears on a previous record (line $nn).");
      }
    else
      {
      do error("$name appears on a previous record.");
      }       
    }
  return;
  }



# Type PTR - pointer to entity elsewhere in the DNS; used only
# for explicit reverse-lookup entries when the name is not in
# this forwards zone. The name must be a complete reversed
# IP address.

if ($type eq "PTR")
  {
  local($net, $rzone);
  local ($nn) = $names{"$name"}; 
  local($a,$b,$c,$d) =
    $name =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;

  if ($duplicate_name_check && $printname !~ /^\s*$/ && $nn > 0)
      {
      do error("unexpected duplicate name.\n".
        "** The first occurrence was in line $nn.");
      }
      
  $names{"$name"} = $nline if $nn == "" || $nn == $used_other;

  if ($a eq "")
    {
    do error("name on PTR record must be complete IP address");
    return;
    }

  if ($a > 255 || $b > 255 || $c > 255 || $d > 255)
    {
    do error("IP address contains component with value greater than 255.");
    return;
    }

  do check_fqn($rest, "PTR");

  $net = ($d << 24) | ($c << 16);
  $net += ($b << 8) if $d >= 192;

  for ($rzone = 0; $rzone < $rzone_count; $rzone++)
    { last if ($net == $rzone_number[$rzone]); }

  if ($rzone >= $rzone_count)
    {
    $net = ($d >= 192)? "$d.$c.$b" : "$d.$c";
    do error("$net is not a known network.");
    }
  else
    {
    $thisaddress = "$d.$c.$b.$a";
    if ($addresses{"$thisaddress"} != "" && !$multiple)
      {
      do error("duplicate IP address $thisaddress specified for a PTR record.\n".
        "** Use the >M flag if multiple PTR records are required.\n".
        "** The first occurrence was in line $addresses{$thisaddress}.");
      }
    else
      {
      local($handle) = "REVERSE$rzone";
      print $handle "$a";
      print $handle ".$b" if $d < 192;
      print $handle "  $ttl $class  PTR  $rest\n";
      $addresses{"$thisaddress"} = $nline
        if $addresses{"$thisaddress"} == "";
      }
    }

  return;
  }
  



# Type DUP - a pseudo record invented for use by makezones,
# specifying that the name is permitted to be duplicated on
# A and PTR records. If this name appeared on a previous CNAME,
# an error will already have been given. Further errors might
# occur whether or not we override, so take the easy line.

if ($type eq "DUP")
  {
  do error("malformed DUP record (text after DUP).") if $rest !~ /^$/;
  $names{"$name"} = $used_dup;
  return; 
  }   



# The remaining record types are classified as "other" for the
# purpose of remembering which names have been used. This is
# purely for the CNAME check. If no type is set, set the conv-
# entional value. This may be overridden by subsequent records
# such as A or PTR.

$names{"$name"} = $used_other if $names{"$name"} == "";
  


# Type NS - identity of nameserver. As the zone's nameserver records were
# processed at the top of the file, these are NS records for devolved sub-
# zones. Check that the name is fully qualified (ends with dot).

if ($type eq "NS")
  {
  do check_fqn($rest, "NS");

  # If the name starts with a digit, it must be the reversed address of
  # a devolved sub-zone of a Class B network.

  if ($name =~ /^\d/)
    {
    local($net, $rzone);
    local($a,$b,$c) = $name =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;

    if ($a eq "")
      {
      do error("subnet name on NS record is invalid.");
      return;
      }

    $net = ($c << 24) | ($b << 16);

    for ($rzone = 0; $rzone < $rzone_count; $rzone++)
      { last if ($net == $rzone_number[$rzone]); }

    if ($rzone >= $rzone_count)
      {
      do error("$c.$b.$a is not a subnet of a known network.");
      }
    else
      {
      local($handle) = "REVERSE$rzone";
      print $handle "$a  $ttl  $class  NS  $rest\n";
      }
    }

  # Otherwise this is a devolution from the main forwards zone

  else { print FORWARD "$printname  $ttl  $class  NS  $rest\n"; }
  return;
  }


# Type HINFO - host information; no further checking

if ($type eq "HINFO")
  {
  print FORWARD "$printname  $ttl  $class  HINFO  $rest\n";
  return;
  }



# Type MX - mail exchanger; there must be a preference and
# a fully-qualified gateway name.

if ($type eq "MX")
  {
  ($pref,$gateway) = split(/\s+/, $rest, 2);
  do check_fqn($gateway, "MX");
  if ($pref !~ /^\d+$/)
    {
    do error("invalid MX preference field (not all digits).");
    }
  print FORWARD "$printname  $ttl  $class  MX  $pref  $gateway\n";
  return;
  }



# Type WKS - well-known services. This commonly is continued onto
# other lines, so we must handle continuations. Check the protocol
# field is either TCP or UDP, then check all the services appear
# in the $services file, if it is set (typically /etc/services).
# Check the address is in a known network, unless external.

if ($type eq "WKS")
  {
  ($address,$proto,$rest) = split(/\s+/, $rest, 3);

  # Check the address

  if (!$external_net)
    {
    local($a,$b,$c,$d) =
      $address =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;

    if ($a eq "")
      {
      do error("IP address on WKS record is incomplete");
      return;
      }

    if ($a > 255 || $b > 255 || $c > 255 || $d > 255)
      {
      do error("IP address contains component with value greater than 255.");
      return;
      }

    $net = ($a << 24) | ($b << 16);
    $net += ($c << 8) if $a >= 192;

    for ($rzone = 0; $rzone < $rzone_count; $rzone++)
      { last if ($net == $rzone_number[$rzone]); }

    if ($rzone >= $rzone_count)
      {
      $net = ($a >= 192)? "$a.$b.$c" : "$a.$b";
      do error("$net is not a known network.");
      }
    }

  # Check the protocol

  if ($proto ne "UDP" && $proto ne "TCP")
    {
    do error("protocol in WKS record must be \"UCP\" or \"TCP\".");
    }

  # Start of line prefix - the rest of the line is in $rest

  $pref = "$printname  $ttl  $class  WKS  $address $proto";

  # Allow continuation bracket at start of list only

  if (substr($rest, 0, 1) eq "(")
    {
    $continued = 1;
    ($list) = $rest =~ /^\(\s*(.+)$/;
    }
  else { $continued = 0; $list = $rest; }

  # Loop for handling continuation records

  for (;;)
    {
    while (substr($list, -1) eq "\n") { chop($list); }
    while (substr($list, -1) eq " ")  { chop($list); }

    # Loop for scanning the list of services

    while ($list ne "")
      {
      if (index($list, " ") >= 0)
        {
        ($servicename,$list) = split(/\s+/, $list, 2);
        }
      else
        {
        $servicename = $list;
        $list = "";

        # Check for closing bracket at end of line. It may or may not
        # be preceded by a space.

        if ($continued && substr($servicename, -1) eq ")")
          {
          chop($servicename);
          $continued = 0;
          }
        }

      # Check the service if required. $servicename can be empty if
      # a closing bracket is preceded by a space.

      if ("$services" ne "" && $servicename ne "")
        {
        if (system("$grep \'^$servicename[ \t]\' $services >/dev/null")/256)
          {
          do error("\"$servicename\" does not appear in $services");
          }
        }
      }

    print FORWARD "$pref  $rest\n";
    return if !$continued;

    # Read in the next line, which contains more services, for the
    # next time round this loop.

    $_ = <SOURCE>;
    $nline++;
    ($list,$dummy) = $_ =~ /^\s*([^;]+)(;.*)?$/;
    $rest = "$list";
    $pref = "  ";
    }
  }



# Type RP (Responsible Person) - two domain names

if ($type eq "RP")
  {
  if ($rest !~ /^\S+\s+\S+$/)
    {
    do error("malformed RP record - two fields required.");
    }
  print FORWARD "$printname  $ttl  $class  RP  $rest\n";
  return;
  }



# Else we have a bad record

do error("unknown record type.");
}





##################################################
#           Generate the zone data               #
##################################################

sub generate_zones{
local($i);

$lastname = "";
$nline = 0;

print "Generating the zone data...\n" if $chatty;

# Open the input file

open(SOURCE, "$source_file") ||
  do give_up("unable to open $source_file");

# Open the output files

open(FORWARD, ">$forward_file.new") ||
  do give_up("unable to open $forward_file.new");

for ($i = 0; $i < $rzone_count; $i++)
  {
  open("REVERSE$i", ">$rzone_file[$i].new") ||
    do give_up("unable to open $rzone_file[$i].new");
  }

# Copy the SOA record into all the output files

for ($nline = 1; $nline <= $soa_count; $nline++)
  {
  $_ = <SOURCE>;
  print FORWARD $_;
  do print_reverse($_);
  }
  
# Record the fact that the name "@" has been used, for a record
# of type "other". This will stop a CNAME of that name.

$names{"$zone_name."} = $used_other; 

# Copy all the NS records for these zones to all the outputs. Stop
# on reaching a non-NS record or a record with a name field. Skip
# blank lines, and handle comments as normal.

# We extend the syntax of NS records by allowing a list of names
# to follow the nameserver name. If this is present, it lists the
# zones to which this nameserver applies. Reverse zones are identified
# by their IP network numbers.

$nline--;
for (;;)
  {
  $_ = <SOURCE>;
  $nline++;
  if (/^;/) { do handle_comment(); next; }
  next if /^\s*$/;
  last if /^\S/;
   
  local($ttl,$class,$ns,$rest) = /^\s+(\d+\s+|)(IN\s+|)NS\s+(\S+)(|\s+.+)$/;
  last if $ns eq "";
  do check_fqn($ns, "NS");

  $rest =~ s/^\s+//;         # strip leading white space
  $rest =~ s/\s*(;.*)?$//;   # strip trailing spaces and comments & NL
  if ($rest eq "")
    {
    print FORWARD $_;
    do print_reverse($_);
    }
  else
    {
    while ($rest ne "")
      {
      ($zone,$rest) = split(/\s+/, $rest, 2);
      if ($zone eq $zone_name)
        {
        print FORWARD "  $ttl  $class  NS  $ns\n";
        }
      else
        {
        local($i);
        local($a,$b,$c,$d) =
          $zone =~ /^\s*(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\s*$/;
        if ($a eq "")
          {
          do error("wrong zone name or malformed network number on NS record");
          }
        else
          {
          $zn = ($a << 24) | ($b << 16) | ($c << 8) | $d;
          for ($i = 0; $i < $rzone_count; $i++)
            {
            if ($rzone_number[$i] == $zn)
              {
              local($handle) = "REVERSE$i";
              print $handle "  $ttl  $class  NS  $ns\n";
              last;
              }
            }
          do error("unknown network number on NS record")
            if $i >= $rzone_count;
          }
        }
      }
    }
  }

# OK, now we have the first general record in $_. We can now scan
# the rest of the file, processing as required. We do a check on
# the first character of the line, because it is easy in moments
# of absent-mindedness to do silly things like put in comments with
# a sharp sign character instead of a semicolon. Let through only
# those characters that can legally begin a line.

for (;;)
  {
  if (!/^\s*$/)
    {
    if (!/^[\s\da-zA-Z\;>\"@\*]/)
      { do error("invalid line - semicolon omitted?"); }
    elsif (substr($_, 0, 1) eq ";")
      { do handle_comment(); }
    else
      { do handle_record(); }
    }
  last if ! ($_ = <SOURCE>);
  $nline++;
  }

# Close all the files

close FORWARD;
close SOURCE;
for ($i = 0; $i < $rzone_count; $i++) { close("REVERSE$i"); }
}




##################################################
#           Compare new/old zone lengths         #
##################################################

sub check_length{
local($length_old, $length_new, $length_diff);
local($name) = $_[0];

if (! -e $name)
  {
  print "\n" if $lastwaserror; 
  print "  " if $chatty; 
  print "Length of $name not checked - previous version of file does not exist\n";
  $lastwaserror = 0; 
  return;
  }

@stat_data = stat($name);
$length_old = $stat_data[7];
@stat_data = stat("$name.new");
$length_new = $stat_data[7];
$length_diff = $length_old - $length_new;

if ($length_diff > ($length_old/20))
  {
  do error("$name.new is more than 5% shorter than $name.\n".
    "** Use -short to override this check.");
  $lastwaserror = 1;
  }
elsif ($chatty)
  {
  print "\n" if $lastwaserror;
  print "  Length of $name is OK\n";
  $lastwaserror = 0;
  }
}


sub compare_lengths{
local($i);
print "Comparing lengths of old and new zone files...\n" if $chatty;
$lastwaserror = 0;
do check_length("$forward_file");
for ($i = 0; $i < $rzone_count; $i++)
  {
  do check_length("$rzone_file[$i]");
  }
}



##################################################
#         Rename new zones to final names        #
##################################################

sub rename_zones {
local($i);
print "Renaming the new zone files to their final names...\n" if $chatty;
rename("$forward_file.new", "$forward_file");
for ($i = 0; $i < $rzone_count; $i++)
  { rename("$rzone_file[$i].new", "$rzone_file[$i]"); }
}



##################################################
#           Remove temporary files               #
##################################################

# This is used to remove the temporary files if processing
# fails. It is not an error for the temps not to exist.

sub remove_temps{
local ($i);
unlink "$forward_file.new";
for ($i = 0; $i < $rzone_count; $i++)
  { unlink "$rzone_file[$i].new"; }
}



##################################################
#                Main Program                    #
##################################################

# After any serious error, the script dies and does not
# return to the main code. Syntax errors etc. carry on,
# leaving $errors containing the count. Only generate_zones()
# and compare_lengths() handle errors in this way - all the 
# other routines generate hard errors.

$rzone_count = $errors = 0;
$soa_count = 6;

# Conventional values for the %names array:

$used_other   = -999999;
$used_reserve = -888888;
$used_dup     = -777777;

# Get weaving...

do unpick_args();
do verify();
do update_serial();
do generate_zones();
print "\n" if $errors > 0;

# No line number for subsequent error messages.

$nline = -1;

# If length checks successful, do renames and end happy.

if ($errors == 0)
  {
  do compare_lengths() if !$opt_short;
  if ($errors == 0)
    {
    do rename_zones();
    print "\nMakezones completed successfully.\n";
    exit 0;
    }
  }

# Something didn't work out...

do remove_temps();
print "\n** Makezones failed.\n";
exit 99;

# End of makezones
