#!/usr/local/bin/perl

# get-dns.pl
#   Contacts an HTTP-based interface to a database,
#     and checks and reads current DNS tables
#   Currently configured for FileMaker Pro 4.0
#
#   Expected input:
#     URL of the HTTP-database interface
#   Prompted if data is missing from the command line
#
#   Expected output:
#     Processed DNS database file in appropriate BIND format
#
#
#   05/03/2000 Version 1.4.2a
#   Use and distribute this script as per the Artistic License
#   Copyright (C) 2001 Igor S. Livshits <mailto:igorl@ayradyss.org>


# Define some constants
#
$true= (1==1);
$false= (1==0);
$newLine= "\n";
$tab= "\t";
$space= " ";
$openToWrite= ">";
$dnsFieldDelimiter= $tab;
$dnsCommentDelimiter= ";";
$dnsInformationField= "HINFO";
$dnsCanonicalNameField= "CNAME";
$dnsAddressField= "\tA\t";
$dnsMailExchangerField= "MX";
$dnsDataFieldIndex= 3;
$dnsMailExchangerFieldIndex= 4;
$ethernetAddressLength= 12;	# ethernet addresses are 12 characters long
$mxIncrement= 10;		# MX consecutive priority increment
$carriageReturn= "\r";
$htmlTableTag= "<table>";
$htmlTableRowTag= "<tr>";
$htmlTableRowTerminator= "</tr>";
$htmlTableCellTag= "<td>";
$htmlTableCellTerminator= "</td>";
$htmlNextURLLeader= "<a href=\"";
$htmlNextURLTrailer= "\">Next set of records</a>";
$htmlRecordCountTotalDelimiter= " of ";
$domainFilePrompt= "Please specify your domain database file:";
$stampFileSuffix= ".stamp";
$databaseURLFileSuffix= ".URL";
$newFileSuffix= ".new";
$oldFileSuffix= ".old";
$lockFileSuffix= ".lock";
$temporaryFileSuffix= ".temp";
$domainHeaderDelimiter= "; General header end";
$dnsTag= "; DO NOT DELETE THIS LINE";
$serialNumberComment= "; Serial #";
$idTag= "Generated by get-dns.pl ";
$updateProcess= "/usr/local/sbin/update-dns.pl";
$dhcpFile= "/etc/bootptab";

# DNS commands and delimiters
$databaseCommandDelimiter= "&";
$databaseCommandDelimiterEncoded= "&amp;";
$databaseCommandArgumentDelimiter= "?";
$databaseCommandArgumentDelimiterMatch= '\?';
$databaseCommandDatabase= "-db=";
$databaseCommandLayout= "-lay=";
$databaseCommandResponse= "-format=";
$databaseCommandSkipRecords= "-skip=";
$databaseCommandMaxRecords= "-max=";
$databaseCommandSearchOperator= "-op=";
$databaseCommandSortField= "-sortField=";
$databaseCommandSortOrder= "-sortOrder=";
$databaseCommandOperator= "-lop=";
$databaseCommandAction= "[action]";

$dnsDatabase= "DNS";
$dnsDefaultAction= "-findall";
$dnsDefaultLayout= "DNS";

# DNS stamp verification command parts
$dnsStampLayout= "Stamp";
$dnsStampResponse= "Latest%20Stamp%20Results.html";
$dnsStampMaxRecords= 1;

# DNS data command parts
$dnsDataResponse= "DNS%20Table.html";
$dnsDataSkipRecords= 0;
$dnsDataMaxRecords= 250;
@dnsDataSearchSpec= ("neq&IP%20name=spare", # ignore all spare IP addresses
		     "neq&IP%20name=reserved"	# and all reserved IP addresses
		     );
$dnsDataAction= "-find";


# Define libraries and modules
#
use Getopt::Long;		# command line options processor
use LWP::Simple;		# libwww-perl package by Gisle Aas
                                # and Martijn Koster


# Initialize
#
GetOptions("d|domain=s" => \$domainFile,
	   "i|isc=s" => \$iscFile,
	   "c|cmu=s" => \$cmuFile,
	   "oc|install-cmu" => \$installCMU,
	   "oi|install-isc" => \$installISC,
	   "g|debug" => \$debug
	   );
umask(0177);

$domainFile= &AskForFilePath($domainFilePrompt) unless $domainFile;

# Set up buffering for live status ticks
#
$currentFileHandle= select(STDOUT);
$|= $true;
select($currentFileHandle);

# Lock the domain
#
&LockDomain($domainFile);
  

# Check for new or changed data, then download and translate the DNS database
#
$dataChanged= &ActivateDNSData($domainFile, &GetDNSData($domainFile));


# Trigger DNS and DHCP systems update if we have new data
#
if ($dataChanged)
{				# trigger the update
  $updateProcess.=		# specify the DNS domain file
    " -d $domainFile";
  $updateProcess.=		# specify the bootptab file
    " -c $cmuFile" if $cmuFile;
  $updateProcess.=		# trigger bootptab replacement
    " -oc" if $installCMU;
  $updateProcess.=		# specify the dhcpd.conf file
    " -i $iscFile" if $iscFile;
  $updateProcess.=		# trigger dhcp.conf replacement
    " -oi" if $installISC;	# and DHCP server restart

  system($updateProcess);
}


# Terminate
#
&Scuttle($domainFile);


#
# Subroutines
#


# AskForFilePath($promptString)
#   Asks for a path to a file, returning it
#   
#   $promptString is just a string displayed to the user
#
sub AskForFilePath
{
  print "$newLine";
  print (shift);
  print "$newLine>";
  
  while (<STDIN>)
  {				# read a line from standard input
    chop;			# kill the terminating newline
    last if -e $_;		# make sure the file exists

    print $newLine, $newLine;
    print "The file you just specified does not seem to exist.$newLine";
    print "Please re-enter the path:$newLine";
    print ">";
  }

  return $_;			# return the file path
}


# LockDomain($dnsFilePath)
#   Check for a lock file for this domain, create if none
#
#   $dnsFilePath is the path to the DNS database file
#
sub LockDomain
{
  local($dnsFilePath)= shift;

  if (-e $dnsFilePath.$lockFileSuffix)
  {
    print "The domain <$dnsFilePath> seems to be locked... ",
    "Scuttling.", $newLine;
    &Scuttle($dnsFilePath);
  }
  else
  {
    if (open(LOCK, $openToWrite.$dnsFilePath.$lockFileSuffix))
    {
      close(LOCK); 
    }
    else
    {
      print "Could not lock the domain <$dnsFilePath>... ",
      "Scuttling.", $newLine;
      &Scuttle($dnsFilePath);
    }
  }
}


# UnlockDomain($dnsFilePath)
#   Clear the lock file for the specified domain file
#
#   $dnsFilePath is the path to the DNS database file
#
sub UnlockDomain
{
  my($dnsFilePath)= shift;

  system("rm $dnsFilePath$lockFileSuffix");
}


# Scuttle($dnsFilePath)
#   Terminate execution -- perhaps something went wrong
#
#   $dnsFilePath is the path to the DNS database file
#
sub Scuttle
{
  my($dnsFilePath)= shift;

  UnlockDomain($dnsFilePath) if (-e $dnsFilePath.$lockFileSuffix);
  exit;
}


# NewDNSData($dnsFilePath)
#   Check for new or modified DNS data
#   
#   $dnsFilePath is the path to the DNS database file
#
sub NewDNSData
{
  my($dnsFilePath)= shift;
  my($databaseURL);		# HTTP-database interface URL
  my($response);		# response from the HTTP-database interface
  my($stamp, $oldStamp);	# serial stamp values

  # Read in the HTTP-database interface URL
  unless (open (URL, $dnsFilePath.$databaseURLFileSuffix))
  {
    print "Could not access $dnsFilePath$databaseURLFileSuffix!$newLine";
    &Scuttle($dnsFilePath);
  }
  $databaseURL= <URL>;
  chop($databaseURL) if ($databaseURL=~ /$newLine$/);
  close(URL);

  # Get and parse the latest stamp response from the database
  $response= get &ConstructDatabaseCommand($databaseURL,
    ($databaseCommandLayout => $dnsStampLayout,
     $databaseCommandResponse => $dnsStampResponse,
     $databaseCommandMaxRecords => $dnsStampMaxRecords));

  if ($debug)
  {				# dump some debugging information
    $response=~ s/$carriageReturn/$newLine/g;
    print $response, $newLine;
  }

  # Match a decimal stamp (should be the only one on a given line :)
  $response=~ 
    /[$newLine$carriageReturn]\s*(\d+\.\d+)\s*[$newLine$carriageReturn]/;
  $stamp= $1;

  # Read in the previous stamp
  unless (open (STAMP, $dnsFilePath.$stampFileSuffix))
  {
    print "Could not access $dnsFilePath$stampFileSuffix;", $newLine,
    $tab, "will reset to zero...", $newLine, $newLine;
    $oldStamp= 0;
  }
  else
  {				# read previous stamp
    $oldStamp= <STAMP>;
    chop($oldStamp) if ($oldStamp=~ /$newLine$/);
    close(STAMP);
  }

  if ($stamp > $oldStamp)
  {
    print "Looks like the database has changed [$stamp].$newLine";
    
    return ($databaseURL, $stamp); # looks like we have new data
  }
  else
  {
    return $false;		# nothing has changed
  }
}


# ConstructDatabaseCommand($databaseURL, %settings)
#   Construct a database command URL from passed data
#   
#   $databaseURL encodes the base URL for the HHTP-database interface
#   %settings is an associative array of command settings
#
sub ConstructDatabaseCommand
{
  my($databaseURL, %settings)= @_;
  my($command);			# the resulting command
  my($searchCriterion);		# one of any search criteria

  # The base URL invoking our HTTP-database interface
  $command= $databaseURL . $databaseCommandArgumentDelimiter;

  # Name the database
  $command.= $databaseCommandDatabase . $dnsDatabase;
  
  # Identify the layout
  $settings{$databaseCommandLayout}= $dnsDefaultLayout
    unless $settings{$databaseCommandLayout};
  $command.= $databaseCommandDelimiter
    . $databaseCommandLayout . $settings{$databaseCommandLayout};
  
  # Specify the response template file
  $command.= $databaseCommandDelimiter
    . $databaseCommandResponse . $settings{$databaseCommandResponse};
  
  # Encodes the search criteria
  foreach $searchCriterion (@{$settings{$databaseCommandSearchOperator}})
  {
    $command.= $databaseCommandDelimiter
      . $databaseCommandSearchOperator . $searchCriterion;
  }
  
  # Keys the sort field and designates sort order
  $command.= $databaseCommandDelimiter . $databaseCommandSortField
    . $settings{$databaseCommandSortField} . $databaseCommandDelimiter
      . $databaseCommandSortOrder . $settings{$databaseCommandSortOrder}
	if ($settings{$databaseCommandSortField} &&
	    $settings{$databaseCommandSortOrder});
  
  # Designate how many matched leading records to skip
  $command.= $databaseCommandDelimiter
    . $databaseCommandSkipRecords . $settings{$databaseCommandSkipRecords}
      if $settings{$databaseCommandSkipRecords};
  
  # Count the maximum of matched records to return
  $command.= $databaseCommandDelimiter
    . $databaseCommandMaxRecords . $settings{$databaseCommandMaxRecords}
      if $settings{$databaseCommandMaxRecords};

  # Trigger the mode of record selection
  $settings{$databaseCommandAction}= $dnsDefaultAction
    unless $settings{$databaseCommandAction};
  $command.= $databaseCommandDelimiter . $settings{$databaseCommandAction};
    
  return $command;
}


# GetDNSData($dnsFilePath)
#   Grab DNS data from the HTTP-database interface
#   
#   $dnsFilePath is the path to the DNS database file
#
sub GetDNSData
{
  my($dnsFilePath)= shift;
  my($databaseURL);		# HTTP-database interface URL
  my($commandURL);		# HTTP-database URL encoded search command
  my($stamp);			# serial stamp of the latest DNS data
  my($response);		# response from the HTTP-database interface
  my($complete);		# signals dataset completeness
  my($recordCount)= 0;		# keeps track of total relevant records
  my($currentFileHandle);
  

  # Check for new or modified data
  ($databaseURL, $stamp)= &NewDNSData($dnsFilePath);
  return $false unless $databaseURL; # Scuttle if there is no new data

  # Construct the first database query
  $commandURL= &ConstructDatabaseCommand($databaseURL,
    ($databaseCommandResponse => $dnsDataResponse,
     $databaseCommandSearchOperator => \@dnsDataSearchSpec,
     $databaseCommandMaxRecords => $dnsDataMaxRecords,
     $databaseCommandAction => $dnsDataAction));

  # Funnel DNS records into a temporary file
  unless (open (DNSTemp, $openToWrite.$dnsFilePath.$temporaryFileSuffix))
  {
    print "Could not access $dnsFilePath$temporaryFileSuffix!$newLine";
    &Scuttle($dnsFilePath);
  }
  print "Fetching DNS records from the database: ";
  while ($true)
  {				# iterate until all database records arrive
    ($response, $commandURL, $complete)= &FormatDNSData(get $commandURL);
    print DNSTemp $response;
    
    # Check for data completeness
    print "$complete "; # a quick tick to indicate progress
    $complete=~ /(\d+)\D(\d+)/;
    $recordCount= $2 unless $recordCount;
    $complete= ($1 == $2);
    if ($recordCount != $2)
    {
      print $newLine,
      $tab, "Error: Total record count mismatch ($recordCount versus $2)",
      $newLine, $tab, "Scuttling.$newLine";
      &Scuttle($dnsFilePath);
    }

    if ($commandURL)
    {				# make the command URL absolute from relative
      $commandURL=~ s/^(.+)$databaseCommandArgumentDelimiterMatch//;
      $commandURL= $databaseURL . $databaseCommandArgumentDelimiter
	. $commandURL;
    }
    else
    {				# we got every record
      print $newLine;		# terminate our status ticks
      if ($complete)
      {
	last;			# we got everything
      }
      else
      {
	print $tab, "Error: Failed to get all the records!", $newLine,
	      $tab, "Scuttling.$newLine";
	&Scuttle($dnsFilePath);
      } 
    }
  }
  close(DNSTemp);

  # Write out the latest stamp
  unless (open (STAMP, $openToWrite.$dnsFilePath.$stampFileSuffix))
  {
    print "Could not access $dnsFilePath$stampFileSuffix!$newLine";
    &Scuttle($dnsFilePath);
  }
  else
  {
    print STAMP $stamp;
    close(STAMP);
  }

  return $stamp;		# pass the stamp along
}


# FormatDNSData($htmlCode)
#   Convert HTML encoded DNS data to native BIND format and return it
#   
#   $htmlCode contains the raw HTML returned by the HTTP-database interface
#
sub FormatDNSData
{
  my($htmlCode)= shift;
  my($dnsData)= "";		# a text chunk of BIND formatted DNS data
  my(@dnsLines, $dnsLine);	# a raw HTML split into lines
  my($nextCommand);		# the command for the next batch of records
  my($complete);		# signals database completion

  if ($debug)
  {				# dump some debuggin information
    unless (open (DUMP, ">dump.html"))
    {
      print "Could not access $dnsFilePath$stampFileSuffix!$newLine";
      &Scuttle($dnsFilePath);
    }
    print DUMP $htmlCode;
    close(DUMP);
  }

  # Kill all line feeds and carriage returns
  $htmlCode=~ s/[$carriageReturn$newLine]//g; 
  # Keep all the header fluff within the first line
  $htmlCode=~ s/$htmlTableTag\s*/$newLine/;
  # Segregate each table row into a line of text
  $htmlCode=~ s/$htmlTableRowTerminator\s*/$newLine/g;
  # Separate each table cell with a tab
  $htmlCode=~ s/$htmlTableCellTerminator\s*$htmlTableCellTag/$tab/g;

  @dnsLines= split (/$newLine/, $htmlCode);
  foreach $dnsLine (@dnsLines)
  {
    # Skip non table row lines
    next unless $dnsLine=~ /^$htmlTableRowTag/;

    # Kill leading table row and cell tags and trailing table cell terminators
    $dnsLine=~ s/^$htmlTableRowTag\s*$htmlTableCellTag//;
    $dnsLine=~ s/$htmlTableCellTerminator\s*$//;

    $dnsData.= $dnsLine.$newLine; # append our processed line
  }

  # Recover the URL for the next batch of entries and the record counter
  $htmlCode=~ /$htmlNextURLLeader(.+)$htmlNextURLTrailer/;
  $nextCommand= $1;		# the URL
  $nextCommand=~ 
    s/$databaseCommandDelimiterEncoded/$databaseCommandDelimiter/g;

  # Recover the record counter
  $htmlCode=~ /(\d+)$htmlRecordCountTotalDelimiter(\d+)/;
  $complete= "$1/$2";	# record counter

  return ($dnsData, $nextCommand, $complete);
}


# ActivateDNSData($dnsFilePath, $stamp)
#   Validate and adjust records while copying them over into a permanent file
#   
#   $dnsFilePath is the path to the DNS database file
#   $stamp is the latest serial stamp
#
sub ActivateDNSData
{
  my($dnsFilePath, $stamp)= @_;
  my($mxPriority);		# MX priority index
  my($name);			# DNS name
  my(@fields);			# fields of a DNS data line

  return $false unless $stamp;	# make sure we received a valid serial stamp

  unless (rename($dnsFilePath, $dnsFilePath.$oldFileSuffix))
  {
    print "Could not preserve $dnsFilePath as $dnsFilePath$oldFileSuffix",
    " ($!)", $newLine;
    &Scuttle($dnsFilePath);
  }
  print "Preserved $dnsFilePath as $dnsFilePath$oldFileSuffix.$newLine";

  # Copy and process DNS records from the temporary file
  unless (open(DNSTemp, $dnsFilePath.$temporaryFileSuffix))
  {
    print "Could not access $dnsFilePath$temporaryFileSuffix!$newLine";
    &Scuttle($dnsFilePath);
  }
  unless (open(DNS, $openToWrite.$dnsFilePath))
  {
    print "Could not access $dnsFilePath!$newLine";
    &Scuttle($dnsFilePath);
  }

  print DNS &DNSHeader($dnsFilePath.$oldFileSuffix, $stamp);

  print $newLine, "Processing records...$newLine";
  while (<DNSTemp>)
  {				# process every record
    chop if /$newLine$/;	# remove the new line from the end

    # Filter every hardware information record
    #  this is also the primary line which defines an IP name
    # 
    if (/$dnsInformationField/)
    {				# validate this record 
      ($name)= split($tab);	# the name is always first
      if ($name=~ /^\w/)
      {				# make sure it starts with an alphanumeric
	if ($name=~ /\./)
	{			# this is not a local record, skip it
	  print $tab, "Skipping external record <$name>.$newLine";
	  while (<DNSTemp>)	# fast forward to the end of this record
	  { last if /^$dnsCommentDelimiter/; }
	}
	else { print DNS $_, $newLine; } # just preserve this line
      }
      else
      {
	print $tab, 
	"Found an invalid name <$name>; skipping record...", $newLine;
	while (<DNSTemp>)	# fast forward to the end of this record
	{
	  last if /^$dnsCommentDelimiter/;
	  print $tab, $tab, $_;	# echo the rest of the record
	}
      }
    }
    
    # Filter every IP address ensuring complete data
    # 
    elsif (/$dnsAddressField/)
    {				# confirm an IP address
      @fields= split($tab);
      unless (@fields[$dnsDataFieldIndex])
      {				# skip blank entries
	print $tab, "Found a blank address entry <$_>; skipping...", $newLine;
	next;
      }
      if (@fields[$dnsDataFieldIndex]=~ /[^0-9\.]/)
      {				# skip if contains an invalid character
	print $tab, "Found an invalid address entry ",
	"<@fields[$dnsDataFieldIndex]>; skipping...", $newLine;
	next;
      }
      print DNS $_, $newLine;
    }
    
    # Filter every IP canonical name ensuring complete data
    # 
    elsif (/$dnsCanonicalNameField/)
    {				# confirm an IP alias
      @fields= split($tab);
      unless (@fields[0]=~ /^\w/)
      {				# skip: invalid alias
	print $tab, "Found an invalid alias entry ",
	"<@fields[0]>; skipping...", $newLine;
	next;
      }
      unless (@fields[$dnsDataFieldIndex]=~ /^\w/)
      {				# skip: invalid reference address
	print $tab, "Found an invalid alias reference entry ",
	"<@fields[$dnsDataFieldIndex]>; skipping", $newLine;
	next;
      }
      print DNS $_, $newLine;
    }
    
    # Filter and adjust every mail exchanger field
    #
    elsif (/$dnsMailExchangerField/)
    {	
      @fields= split($tab);
      unless (@fields[$dnsMailExchangerFieldIndex]=~ /^\w/)
      {				# skip if starts with an invalid character
	print $tab, "Found an invalid MX entry ",
	"<@fields[$dnsMailExchangerFieldIndex]>; skipping...", $newLine;
	next;
      }

      s/$tab\d+$tab/$tab$mxPriority$tab/; # correct the priority field
      print DNS $_, $newLine;
      $mxPriority+= $mxIncrement; # increment for the next MX record
    }
    
    elsif (/^$dnsCommentDelimiter/)
    {				# new record boundary
      $mxPriority= $mxIncrement; # reset MX record count
      print DNS $_, $newLine;
    }
    
    else { print DNS $_, $newLine; } # just preserve this line
  }

  close(DNS);
  close(DNSTemp);

  print $newLine, "New DNS data ready.$newLine$newLine";
  return $true;
}


# DNSHeader($dnsFilePath, $stamp)  
#   Construct a bind-8.x compliant DNS database file header
#   
#   $dnsFilePath is the path to a current valid DNS database
#   $stamp is the latest serial stamp
#
sub DNSHeader
{
  my($dnsFilePath)= shift;
  my($stamp)= shift;
  my(@dnsHeader)= ();		# the lines comprising our header
  my($aLine);			# a given line from the header
  my($serialNumber);		# the current serial number
  my($second, $minute, $hour, $day, $month, $year)= localtime(time());

  # Generate a current time stamp tag
  $month++;			# correct for 0 based count
				# and pad single digits
  $minute= "0".$minute if ($minute < 10);
  $second= "0".$second if ($second < 10);
  $year+= 1900;			# add centuries
  push(@dnsHeader, "$dnsCommentDelimiter $idTag"); # stamp with our tag
  push(@dnsHeader, "$hour:$minute:$second $month/$day/$year$newLine");

  # Read in the standard header
  unless (open(DNSHeader, $dnsFilePath))
  {
    print "Could not access $dnsFilePath!$newLine";
    &Scuttle($dnsFilePath);
  }
  while ($aLine= <DNSHeader>)
  {				# gather the standard header
    next if ($aLine=~ /$idTag/); # ignore the previous time stamp tag
    
    if ($aLine=~ /$serialNumberComment$/)
    {				# update the serial number
      $aLine=~ /(\d+)/;		# it should be the first series of digits
      $serialNumber= $1;

      $stamp=~ /(\d+)/;		# grab the integer part
      $stamp= $1;
      # Make sure the new serial number exceeds the previous one
      if ($stamp <= $serialNumber)
      {
	$stamp= $serialNumber+1;
      }
      $aLine=~ s/$serialNumber/$stamp/;
    }
    
    push(@dnsHeader, $aLine);
    
    last if ($aLine=~ /^$dnsTag/);
  }
  close(DNSHeader);

  print $newLine, "Copied the DNS header from $dnsFilePath.$newLine";
  return @dnsHeader;
}