#!/bin/perl

$version_number = "0.32 [04-Jan-00]";

# This script was developed using Perl 4.036. It has now been converted
# to Perl 5.002. If you want to run it under Perl 4, you need to delete
# the line that contains "use integer" below.


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

# Copyright (c) University of Cambridge 1993 - 1999
#
# 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 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 originally handled only Class B and Class C networks, because
# those are the ones that are around here in Cambridge, UK. However, from
# version 0.20 it also handles Class A networks.
#
# From version 0.30 it is capable of handling AAAA records for IPv6 addresses.
#
# 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,
#     comment and $TTL 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.
#
#   . $TTL is permitted only prior to the SOA record. It is simply copied
#     to the generated zone files, and in no way interpreted here.
#
#   . 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.
#
#     IPv6 reverse zones are identified by the leading part of the address
#     that corresponds to the zone. The presence of a colon indicates an
#     IPv6 address.
#
#   . 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 and AAAA records can be marked as "reverse only" by preceding
#     them with ">R " at the start. In this case, no 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, A records, and AAAA records are the only ones used when
#     generating the reverse zone files. A and AAAA records can be marked
#     "forwards only" by preceding 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 and/or AAAA 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, AAAA, 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 addresses 127.0.0.1 and ::1 are recognized and
#     treated as though ">E " is always present. The ">E " flag can be used on
#     WKS records as well as on A and AAAA 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 or AAAA 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 A, Class B, or Class C network
# number for IPv4 reverse zones, or with an initial portion of an IPv6 address
# for IPv6 reverse zones. A colon must be present to indicate an IPv6 reverse
# zone, e.g. db.12ab:2300. The zone is taken to be the sequence of trailing
# hex digits, excluding colons. All zeros must be included.
#
# [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.
#   0.10   02-Nov-94  Some unrecorded change...
#   0.20   29-Jul-96  Added class A support.
#                     Changed "do sub" to "&sub" as "do" is deprecated in Perl 5
#                     Checked out with Perl 5.002
#   0.21   27-Feb-97  Allow for whitespace after ( in SOA record
#   0.22   03-Mar-97  Allow names on the rhs of records to have components
#                     that start with a digit without special notation
#   0.30   15-Apr-97  Addition of IPv6 support; treat as prototype...
#   0.31   24-Jun-99  Support $TTL before SOA (only)


##################################################
#            Integer arithmetic                  #
##################################################

# All the arithmetic herein is integer, so tell Perl it can use
# integer operations. In fact, without this, the script falls over
# in Perl 5 because some of the numbers representing IP numbers
# use bit 31.

use integer;



##################################################
#            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 {
&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)
  {
  &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 { &give_up("unknown option \"$ARGV[0]\""); }
  shift ARGV;
  }

# Now we should be left with at least four arguments

&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;

  # If the name contains a colon, treat it as an IPv6 zone file name. The
  # zone itself is taken as all the trailing digits, excluding any colons.
  # For a high-level zone such as, e.g. 5, just add a superfluous trailing
  # colon.

  if ($rzone =~ /:/)
    {
    my($net) = $rzone =~ /([\da-f:]+)$/i;
    $net =~ s/://g;
    $rzone_number[$rzone_count++] = "\L$net";
    }

  # Check explicitly for a class 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.

  else
    {
    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})$/;
      if ("$a" eq "")
        {
        ($a) = $rzone =~ /^.*\.(\d{1,3})$/;
        &give_up("bad class A network $a") if ($a > 127);
        $rzone_number[$rzone_count++] = $a << 24;
        }
      else
       {
        &give_up("bad class B network $a.$b") if ($a < 128 || $a > 191);
        $rzone_number[$rzone_count++] = ($a << 24) | ($b << 16);
        }
      }
    else
      {
      &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") ||
  &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*;/ && !/^\$TTL\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*\(\s*$/;
  }
else
  {
  ($host,$hostmaster) = $rest =~ /^IN\s+SOA\s+(\S+)\s+(\S+)\s*\(\s*$/;
  }

&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*;.*|)$/;
&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*;.*|)$/;
  &give_up("line $i of the SOA record is malformed") if ($check eq "");
  }

# Calculate the serial number for the first update of today.

local @today = localtime;
local $today_serial = sprintf( '%4d%02d%02d01', $today[5]+1900, $today[4]+1, $today[3] );

# 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 /)
  {
  &print_reverse(join("", "; ", substr($_, 3)));
  }
}





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

sub check_fqn{
&error("$_[1] record must point to a valid, fully qualified name.")
  if ($_[0] !~ /^[a-zA-Z\d][a-zA-Z\d\-]*(\.[a-zA-Z\d][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 "")
  {
  &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+$/)
    {
    &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 & AAAA records, except that >E may be specified for
# WKS records, and >M for PTR records.

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

# 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)
    {
    &error("invalid wildcard name field\n".
             "** (or other components do not match name pattern).");
    $name = $lastname = "dummy";     # prevent subsequent errors
    }
  elsif ($type ne "MX")
    {
    &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")
    {
    &error("invalid name field for this type of record.");
    $name = $lastname = "dummy";     # prevent subsequent errors
    }
  }
elsif ($name !~ /^$name_pattern(\.$name_pattern)*$/o)
  {
  # An invalid name might be valid as an IPv6 reversed name on a PTR,
  # NS or DUP record. We can't check till here, as a valid ordinary
  # name such as a.b.c.d can also be a valid IPv6 reversed name.
  # Full checking of IPv6 reversed names happens later.

  if (($type ne "PTR" && $type ne "NS" && $type ne "DUP") ||
       $name !~ /^[\da-f](\.[\da-f])*$/i)
    {
    &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)
  {
  &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"};
  &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*(;.*)?$/)
    {
    &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")
  {
  &error("malformed RESERVE record (text after RESERVE).") if $rest !~ /^$/;
  if ($names{"$name"} ne "")
    {
    &error("reserved name $name previously used.");
    }
  else { $names{"$name"} = $used_reserve; }
  return;
  }



# Type A - IPv4 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)
      {
      &error("unexpected duplicate name.\n".
        "** The first occurrence was in line $nn.");
      }

  $names{"$name"} = $nline if $nn == "" || $nn == $used_other;

  if ($a eq "")
    {
    &error("IP address is incomplete.");
    return;
    }

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

  &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;

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

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

    if ($rzone >= $rzone_count)
      {
      &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)
      {
      &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 ".$b" if ($a < 128);
      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 AAAA - IPv6 host address; the address must be in one of the networks
# being processed, unless it was flagged as an external network.

if ($type eq "AAAA")
  {
  my($rzone,$zrest,$adr);
  my($nn) = $names{"$name"};

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

  $names{"$name"} = $nline if $nn == "" || $nn == $used_other;

  # IPv6 addresses are either in V4-compatible form or are pure V6. In
  # former case, turn the V4 bit into hex

  if ($rest =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
    {
    $adr = sprintf("$`%04x:%04x", ($1 << 8) | $2, ($3 << 8) | $4);
    }
  else { $adr = $rest; }

  # Parse an IPv6 address and turn it into a complete hex representation,
  # with all omitted zeroes included.

  my(@component) = split /:/, $adr, -1;

  # If the first component is null, then the second one must be too, to
  # correspond to an address starting with ::, and we just sling the
  # first component.

  if ($component[0] eq "")
    {
    if (@component < 2 || $component[1] ne "")
      {
      &error("Invalid IPv6 address starting with an empty component.");
      return;
      }
    shift @component;
    }

  # The last component may be null only if the address ends with a
  # double colon; throw away the last component. If the address contains
  # two double colons, an error will be generated below.

  if ($component[-1] eq "")
    {
    if (@component < 2 || $component[-2] ne "")
      {
      &error("IPv6 address may not end with a colon");
      return;
      }
    pop @component;
    }

  # The maximum number of components is 8

  if (@component > 8)
    {
    &error("Too many colons in IPv6 address");
    return;
    }

  # If there are fewer than 8, there must be a null one; expand it to
  # fill as many slots as necessary. The last component is null only if
  # it is the wild one (checked above).

  if (@component < 8)
    {
    my($hadnull) = 0;
    for ($i = 0; $i < @component; $i++)
      {
      if ($component[$i] eq "")
        {
        if ($hadnull)
          {
          &error("Only one null component allowed in IPv6 address");
          return;
          }
        $hadnull = 1;
        splice @component, $i, 1, (0) x (9 - @component);
        }
      }
    if (@component != 8)
      {
      &error("Too few components in IPv6 address");
      return;
      }
    }

  # Make a single string consisting of the hex representations
  # concatenated, with leading zeros.

  my($s) = "";
  for ($i = 0; $ i < 8; $i++)
    {
    $s .= sprintf("%04x", hex $component[$i]);
    }

  # The loopback address is always treated as external

  $external_net = $forwards_only = 1
    if $s eq "00000000000000000000000000000001";;

  # Check known network (& find network) unless external

  if (!$external_net)
    {
    for ($rzone = 0; $rzone < $rzone_count; $rzone++)
      {
      if ($s =~ /^$rzone_number[$rzone]/)
        {
        $zrest = $';
        last;
        }
      }

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

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

  print FORWARD "$printname  $ttl  $class  AAAA  $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)
    {
    my($oldline) = $addresses{"$s"};

    # Check for duplicates

    if ($oldline != "" && !$multiple)
      {
      &error("duplicate IPv6 address $rest \n   specified for a PTR record.\n".
        "** Use the >M flag if multiple PTR records are required.\n".
        "** The first occurrence was in line ${oldline}.");
      }

    # Reverse the remainder address (the part after the reverse zone name),
    # insert dots between the digits, and output the record.

    else
      {
      my($sr) = scalar(reverse $zrest);  # Default context is list...
      $sr = join ('.', split(//, $sr));
      local($handle) = "REVERSE$rzone";
      print $handle "$sr  $ttl  $class  PTR  $name";
      print $handle ".$zone_name." if (substr($name, -1, 1) ne ".");
      print $handle "\n";
      $addresses{"$s"} = $nline if !defined $addresses{"$s"};
      }
    }

  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"};
  &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;
      &error("$name appears on a previous record (line $nn).");
      }
    else
      {
      &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. An IPv6 address is detected by the presence of more
# than 4 components. Keep the code separate for tidiness.

# Handle IPv4 PTR record

if ($type eq "PTR" && ($name =~ tr/././) <= 3)
  {
  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)
      {
      &error("unexpected duplicate name.\n".
        "** The first occurrence was in line $nn.");
      }

  $names{"$name"} = $nline if $nn == "" || $nn == $used_other;

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

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

  &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";
    &error("$net is not a known network.");
    }
  else
    {
    $thisaddress = "$d.$c.$b.$a";
    if ($addresses{"$thisaddress"} != "" && !$multiple)
      {
      &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;
  }


# Handle IPv6 PTR record

if ($type eq "PTR")
  {
  local($s, $rzone);
  local ($nn) = $names{"$name"};

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

  $names{"$name"} = $nline if $nn == "" || $nn == $used_other;

  $name = "\L$name";
  my(@component) = reverse split(/\./, $name);

  if (@component != 32)
    {
    &error("name on PTR record must be complete reversed IPv6 address");
    return;
    }

  foreach $c (@component)
    {
    if ($c !~ /^[\da-f]$/)
      {
      &error("IPv6 address contains component that is not a hex digit.");
      return;
      }
    }

  &check_fqn($rest, "PTR");

  # Make the full IPv6 address in order to check for the zone

  $" = "";
  $s = "@component";
  $" = " ";

  for ($rzone = 0; $rzone < $rzone_count; $rzone++)
    {
    if ($s =~ /^$rzone_number[$rzone]/)
      {
      $zrest = $';
      last;
      }
    }

  # Make a canonical representation of the name for the error message
  # and for tracking duplicates

  $s = "";
  for ($i = 0; $i < 32; $i++)
    {
    $s .= ":" if $i != 0 && ($i & 3) == 0;
    $s .= $component[$i];
    }

  # Endure the domain is known

  if ($rzone >= $rzone_count)
    {
    &error("IPv6 address $s is not in a known reverse domain.");
    return;
    }

  # Check for duplication

  if ($addresses{"$s"} != "" && !$multiple)
    {
    &error("duplicate IPv6 address $s\n   specified for a PTR record.\n".
      "** Use the >M flag if multiple PTR records are required.\n".
      "** The first occurrence was in line $addresses{$s}.");
    return;
    }

  # Output the PTR record

  local($handle) = "REVERSE$rzone";
  $zrest = join ".", (reverse split(//, $zrest));
  print $handle "$zrest  $ttl $class  PTR  $rest\n";
  $addresses{"$s"} = $nline if $addresses{"$s"} == "";
  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")
  {
  &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")
  {
  &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 A or Class B network for an IPv4 address.
  # In the IPv6 world devolution can happen at any digit of the address.
  # Unfortunately, there can be ambiguities here as to whether the name
  # is IPv4 or IPv6. If there are more than 2 dots, or there are hex digits,
  # then it's definitely IPv6. Otherwise, try for an IPv4 devolution, but
  # if it doesn't correspond to a subnet, try for IPv6.

  my($isv4) = 0;
  my($isv6) = 0;
  my($isforward) = 0;

  # If it starts with a non-hex digit, it is definitely forward

  if ($name !~ /^[\da-f]/i) { $isforward = 1; }

  # Else if it contains only decimal digits, it could be IPv4 or IPv6

  elsif ($name =~ /^[\d\.]+$/) { $isv6 = 1; $isv4 = 1; }

  # Else if it start with a digit it must be IPv6 (since it's not all
  # decimal digits).

  elsif ($name =~ /^\d/) { $isv6 = 1; }

  # Else it could be IPv6 or it could be forward

  else { $isv6 = 1; $isforward = 1; }

  # Handle a possible IPv4 devolution

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

    if ($a eq "")
      {
      ($a,$b) = $name =~ /^(\d{1,3})\.(\d{1,3})$/;
      if ($a eq "")
        {
        goto TRY_IPV6 if ($isv6);
        &error("subnet name on NS record is invalid.");
        return;
        }
      $net = $b << 24;
      $subnet = "$b.$a";
      }
    else
      {
      $net = ($c << 24) | ($b << 16);
      $subnet = "$c.$b.$a";
      }

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

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

  TRY_IPV6:

  # Handle a possible IPv6 devolution

  if ($isv6)
    {
    $name = "\L$name";
    my(@component) = reverse split(/\./, $name);

    foreach $c (@component)
      {
      if ($c !~ /^[\da-f]$/)
        {
        goto TRY_FORWARD if ($isforward);
        &error("IPv6 address contains component that is not a hex digit.");
        return;
        }
      }

    # Make the IPv6 address in order to check for the zone

    $" = "";
    $s = "@component";
    $" = " ";

    for ($rzone = 0; $rzone < $rzone_count; $rzone++)
      {
      if ($s =~ /^$rzone_number[$rzone]/)
        {
        $zrest = $';
        last;
        }
      }

    # Make a canonical representation of the name for the error message

    $s = "";
    for ($i = 0; $i < @component; $i++)
      {
      $s .= ":" if $i != 0 && ($i & 3) == 0;
      $s .= $component[$i];
      }

    # Endure the domain is known

    if ($rzone >= $rzone_count)
      {
      goto TRY_FORWARD if ($isforward);
      &error("IPv6 address $s is not in a known reverse domain.");
      return;
      }

    # Output the record

    $zrest = reverse $zrest;
    $zrest = join(".", split(//, $zrest));
    local($handle) = "REVERSE$rzone";
    print $handle "$zrest  $ttl  $class  NS  $rest\n";
    return;
    }

  TRY_FORWARD:

  # This is a devolution from the main forwards zone

  if ($isforward) { 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);
  &check_fqn($gateway, "MX");
  if ($pref !~ /^\d+$/)
    {
    &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 "")
      {
      &error("IP address on WKS record is incomplete");
      return;
      }

    if ($a > 255 || $b > 255 || $c > 255 || $d > 255)
      {
      &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";
      &error("$net is not a known network.");
      }
    }

  # Check the protocol

  if ($proto ne "UDP" && $proto ne "TCP")
    {
    &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)
          {
          &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+$/)
    {
    &error("malformed RP record - two fields required.");
    }
  print FORWARD "$printname  $ttl  $class  RP  $rest\n";
  return;
  }



# Else we have a bad record

&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") ||
  &give_up("unable to open $source_file");

# Open the output files

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

for ($i = 0; $i < $rzone_count; $i++)
  {
  open("REVERSE$i", ">$rzone_file[$i].new") ||
    &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 $_;
  &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, or in the case of IPv6 zones, by the first
# part of an IPv6 address.

$nline--;
for (;;)
  {
  $_ = <SOURCE>;
  $nline++;
  if (/^;/) { &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 "";
  &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 $_;
    &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
        {
        # The presence of a colon indicates an IPv6 reverse zone.
        # The zone number is the sequence of digits without the colons.

        if ($zone =~ /:/)
          {
          $zone =~ s/://g;
          $zone = "\L$zone";
          for ($i = 0; $i < $rzone_count; $i++)
            {
            if ($rzone_number[$i] eq $zone)
              {
              local($handle) = "REVERSE$i";
              print $handle "  $ttl  $class  NS  $ns\n";
              last;
              }
            }
          &error("unknown reverse zone number on NS record")
            if $i >= $rzone_count;
          }

        # Else handle IPv4 zone

        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 "")
            {
            &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;
                }
              }
            &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\;>\"@\*]/)
      { &error("invalid line - semicolon omitted?"); }
    elsif (substr($_, 0, 1) eq ";")
      { &handle_comment(); }
    else
      { &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))
  {
  &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;
&check_length("$forward_file");
for ($i = 0; $i < $rzone_count; $i++)
  {
  &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...

&unpick_args();
&verify();
&update_serial();
&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)
  {
  &compare_lengths() if !$opt_short;
  if ($errors == 0)
    {
    &rename_zones();
    print "\nMakezones completed successfully.\n";
    exit 0;
    }
  }

# Something didn't work out...

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

# End of makezones
