# Parse a Bind8 DB
#
# Copyright Karthik Krishnamurthy <karthik.k@extremix.net>
package Unix::Conf::Bind8::DB;
use strict;
use warnings;
use Unix::Conf;
use Unix::Conf::Bind8::DB::Lib;
#
my $ttl_pat = qr/(?:\d+[wdhms])+|\d+/oi;
my $type_pat = qr/SOA|A|NS|MX|CNAME|PTR/oi;
my $class_pat = qr/IN/oi;
my ($FH, @Parse_Stack, $DB_Origin, $DB, %Args, $Include_Encountered);
sub __pushfile () { push (@Parse_Stack, [ $FH ]); }
sub __popfile () { ($FH) = @{pop (@Parse_Stack)}; }
# forward decl to suppress warning
sub __parse_loop ($$);
sub __parse_db ($)
{
$DB = $_[0];
# make the origin absolute.
$DB_Origin = $DB->origin ();
__parse_loop ($DB->fh (), $DB->origin ());
# clean so we don't sync to db just because we read in the data
# but don't do it if we encountered an $INCLUDE, as we delete
# the include file and print all the data in this one.
$DB->dirty (0) unless ($Include_Encountered);
undef ($DB);
return (1);
}
sub __die ($;$)
{
die ($_[0]) if (@_ == 1);
die (Unix::Conf->_err (sprintf ("$_[0]($FH:%s)",$FH->lineno ()), "$_[1]\n"))
}
sub __parse_loop ($$)
{
__pushfile ();
$FH = $_[0];
my $corigin = $_[1];
my ($def_ttl, $line, @tokens);
my ($token, $rtype, $ret);
while (defined (($line = __getline ()))) {
# this is for the method call at the end of this loop.
no strict 'refs';
($line =~ /^\$TTL(?:\s+)($ttl_pat+)(?:\s*)$/i) && do {
$def_ttl = $1;
next;
};
#
($line =~ /^\$ORIGIN\s+([\w.-]+)\s*$/i) && do {
# if the argument to $ORIGIN is not absolute make it into one
$corigin = __make_absolute ($corigin, $1);
next;
};
# read in data and delete the file.
($line =~ /^\$INCLUDE\s+(\S+)\s*(\S*)\s*$/) && do {
# $DB->new_include ();;
my ($fh, $origin);
$fh = Unix::Conf->_open_conf (NAME => $1, SECURE_OPEN => 0) or
return ($fh);
$origin = __make_absolute ($origin, $2);
__parse_loop ($fh, $origin);
$Include_Encountered = 1;
next;
};
@tokens = split (/\s+/, $line);
# get label for the record
$token = shift (@tokens);
if ($token eq '@') {
$Args{LABEL} = __make_relative ($DB_Origin, $corigin);
}
# __make_absolute only if label exists. otherwise
# we will do it to the last label, which could
# result in an error if it was empty.
elsif ($token) {
$Args{LABEL} = __make_relative ($DB_Origin, __make_absolute ($corigin, $token));
}
# if there was no label specifed, the last one used
# remains.
# check to see if next token is TTL or CLASS.
(($token = shift (@tokens)) =~ /^$ttl_pat$/) && do {
$Args{TTL} = $token; $token = shift (@tokens);
};
($token =~ /^$class_pat$/) && do {
$Args{CLASS} = $token; $token = shift (@tokens);
};
# at this point what we have must be the record type
__die ('__parse_db', "illegal record type `$token'")
unless ($token =~ /^$type_pat$/);
$rtype = $token;
if ($rtype =~ /soa/i) {
__die ('__parse_loop', "SOA owner `$Args{LABEL}' not same as DB origin `$DB_Origin'")
if (__make_absolute ($DB_Origin, $Args{LABEL}) ne $DB_Origin);
($Args{AUTH_NS}, $Args{MAIL_ADDR}, $Args{SERIAL}, $Args{REFRESH},
$Args{RETRY}, $Args{EXPIRE}, $Args{MIN_TTL}) = @tokens;
$Args{AUTH_NS} = __make_relative ($corigin, $Args{AUTH_NS});
$Args{MAIL_ADDR} = __make_relative ($corigin, $Args{MAIL_ADDR});
}
elsif ($rtype =~ /mx/i) {
$Args{MXPREF} = shift (@tokens);
$Args{RDATA} = __make_relative ($DB_Origin, __make_absolute ($corigin, shift (@tokens)));
}
# RDATA for A are not labels but IP addresses so don't try append with corigin
elsif ($rtype =~ /a/i) {
$Args{RDATA} = shift (@tokens);
}
else {
$Args{RDATA} = __make_relative ($DB_Origin, __make_absolute ($corigin, shift (@tokens)));
}
# invoke as a subroutine but pass the object as the first
# argument, method like.
$ret = &{"new_\L$rtype\E"} ($DB, %Args) or __die ($ret);
}
__popfile ();
}
sub __getline
{
while (<$FH>) {
chomp;
s/^(.*?);.*$/$1/;
# get another line if no non white space chars after stripping comment
next if ($_ !~ /\S/);
if (s/^(.+)\(\s*$/$1/) {
my $tmp;
while (defined (($tmp = <$FH>))) {
$tmp =~ s/^(.*?);.*$/$1/;
$_ .= $tmp;
last if (s/^([^)]+)\).*$/$1/);
}
# remove any newline added above in the while loop
chomp;
}
return ($_);
}
return;
}
1;