makezones

早期freebsd实现

    }
  }
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\-]*)*\.\s*$/)
}




##################################################
#              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).

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

# If the record starts with ">E ", ">F " or ">R " it is for the forward
# or reverse zones only. 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 (/^>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- and reverse-only flags may be specified only for A records,
# except that >E may be specified for WKS records.

if ($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)*$/)
    {
    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 record - full checking of the
  # name happens later for PTR & NS records. 
  if ($type ne "PTR" && $type ne "NS")
    {  
    do error("invalid name field for this type of record.");
    $name = $lastname = "dummy";     # prevent subsequent errors
    }  
  }
elsif ($name !~ /^$name_pattern(\.$name_pattern)*$/) 
  { 
  do error("invalid name field (components do not match name pattern).");
  $name = $lastname = "dummy";     # prevent subsequent errors
  }



# 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.



# 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($a,$b,$c,$d) = 
    $rest =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\s*$/;

  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" if !$reverse_only;
  
  # If required, generate a PTR record for the reverse file.
 
  if (!$forwards_only)
    {
    $thisaddress = "$a.$b.$c.$d"; 
    if ($addresses{"$thisaddress"} != "")
      {
      do error("duplicate IP address $thisaddress specified for a PTR record.\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;
      } 
    }  
    
  return; 
  }



# 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";
      }       
    }
    
  # Otherwise this is a devolution from the main forwards zone
  
  else { print FORWARD "$printname  $ttl  $class  NS  $rest"; }
  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.
# We do this by keeping a list of CNAME names in an associative array,
# and re-scanning the file at the end.

if ($type eq "CNAME")
  {
  do check_fqn($rest, "CNAME");  
  if ($cnames{"$name"} eq "")
    { 
    $cnames{"$name"} = $nline;
    print FORWARD "$name  $ttl $class  CNAME  $rest";
    }
  else 
    { 
    do error("$name appears on a previous CNAME record (line $cnames{$name}).");
    } 
  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($a,$b,$c,$d) = 
    $name =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
    
  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++)