File Coverage

blib/lib/BIND/Conf_Parser.pm

Criterion	Covered	Total	%
statement	27	523	5.1
branch	0	236	0.0
condition	0	36	0.0
subroutine	9	55	16.3
pod	14	46	30.4
total	50	896	5.5

#
# BIND::Conf_Parser - Parser class for BIND configuration files
#
package BIND::Conf_Parser;

use Carp;

use strict;
use integer;
use vars qw($VERSION);

$VERSION = "0.95";

# token classes
use constant WORD	=> 'W';
use constant STRING	=> '"';
use constant NUMBER	=> '#';
use constant IPADDR	=> '.';
use constant ENDoFILE	=> '';

sub choke {
    shift;
    confess "parse error: ", @_
}

sub set_toke($$;$) {
    my($self, $token, $data) = @_;
    $self->{_token} = $token;
    $self->{_data} = $data;
}


sub where($;$) {
    my $self = shift;
    if (@_) {
	$self->{_file} . ":" . $_[0]
    } else {
	$self->{_file} . ":" . $self->{_line}
    }
}

sub read_line($) {
    my $self = shift;
    $self->{_line}++;
    chomp($self->{_curline} = $self->{_fh}->getline);
}

sub check_comment($) {
    my $self = shift;
    for my $i ($self->{_curline}) {
	$i=~m:\G#.*:gc			and last;
	$i=~m:\G//.*:gc			and last;
	if ($i=~m:\G/\*:gc) {
	    my($line) = $self->{_line};
	    until ($i=~m:\G.*?\*/:gc) {
		$self->read_line || $i ne "" ||
			$self->choke("EOF in comment starting at ",
				     $self->where($line));
	    }
	}
	return 0
    }
    return 1
}

sub lex_string($) {
    my $self = shift;
    my($s, $line);
    $line = $self->{_line};
    $s = "";
    LOOP: for my $i ($self->{_curline}) {
# the lexer in bind doesn't implement backslash escapes of any kind
#	$i=~/\G([^"\\]+)/gc		and do { $s .= $1; redo LOOP };
#	$i=~/\G\\(["\\])/gc		and do { $s .= $1; redo LOOP };
	$i=~/\G([^"]+)/gc		and do { $s .= $1; redo LOOP };
	$i=~/\G"/gc			and $self->set_toke(STRING, $s), return;
	# Must be at the end of the line
	if ($self->read_line) {
	    $s .= "\n";
	} elsif ($i eq "") {
	    $self->choke("EOF in quoted string starting at ",
			 $self->where($line));
	}
	redo LOOP;
    }
}

sub lex_ident($$) {
    my $self = shift;
    my($i) = @_;
    while (! $self->check_comment &&
	   $self->{_curline} =~ m:\G([^/"*!{};\s]+):gc) {
	$i .= $1;
    }
    $self->set_toke(WORD, $i);
}

sub lex_ipv4($$) {
    my $self = shift;
    my($i) = @_;
    LOOP: for my $j ($self->{_curline}) {
	$self->check_comment		and last LOOP;
	$j=~/\G(\d+)/gc			and do { $i .= $1; redo LOOP };
	$j=~/\G(\.\.)/gc ||
	$j=~m:\G([^./"*!{};\s]+):gc		and $self->lex_ident("$i$1"),	return;
	$j=~/\G\./gc			and do { $i .= "."; redo LOOP };
    }
    my($dots);
    $dots = $i =~ tr/././;
    if ($dots > 3 || substr($i, -1) eq '.') {
	$self->set_toke(WORD, $i);
	return
    }
    if ($dots == 1) {
	$i .= ".0.0";
    } elsif ($dots == 2) {
	$i .= ".0";
    }
    $self->set_toke(IPADDR, $i);
}

sub lex_number($$) {
    my $self = shift;
    my($n) = @_;
    LOOP: for my $i ($self->{_curline}) {
	$self->check_comment	and last LOOP;
	$i=~/\G(\d+)/gc		and do { $n .= $1; redo LOOP };
	$i=~/\G\./gc		and $self->lex_ipv4("$n."),	return;
	$i=~m:\G([^/"*!{};\s]+):gc	and $self->lex_ident("$n$1"),	return;
    }
    $self->set_toke(NUMBER, $n);
}

sub lex($) {
    my $self = shift;
    OUTER: while(1) { for my $i ($self->{_curline}) {
	INNER: {
	    $self->check_comment	and last INNER;
	    $i=~/\G\s+/gc			and redo;
	    $i=~m:\G([*/!{};]):gc		and $self->set_toke($1),   last OUTER;
	    $i=~/\G"/gc			and $self->lex_string(),   last OUTER;
	    $i=~/\G(\d+)/gc			and $self->lex_number($1), last OUTER;
	    $i=~/\G(.)/gc			and $self->lex_ident($1),  last OUTER;
	}
	$i=~/\G\Z/gc or $self->choke("Unknown character at ", $self->where);
	$self->read_line || $i ne "" or $self->set_toke(ENDoFILE), last OUTER;
    } }
    return $self;
}

sub t2d($) {
    my $self = shift;
    $self->{_token} eq WORD	and return qq('$self->{_data}');
    $self->{_token} eq STRING	and return qq("$self->{_data}");
    $self->{_token} eq NUMBER ||
    $self->{_token} eq IPADDR	and return $self->{_data};
    $self->{_token} eq ENDoFILE	and return "";
    return qq('$self->{_token}');
}

sub t2n($;$) {
    my($token, $need_article);
    my($map) = {
	WORD		, [ an => "identifier"],
	STRING		, [ a  => "string"],
	NUMBER		, [ a  => "number"],
	IPADDR		, [ an => "IP address"],
	ENDoFILE	, [ "End of File"],
	'*'		, [ an => "asterisk"],
	'!'		, [ an => "exclamation point"],
	'{'		, [ an => "open brace"],
	'}'		, [ a  => "close brace"],
	';'		, [ a  => "semicolon"],
    }->{$token};
    return "Fwuh?  `$token'" unless $map;
    if ($need_article) {
	join(" ", @{ $map })
    } else {
	$map->[-1]
    }
}

sub expect($$$;$) {
    my $self = shift;
    my($token, $mess, $nolex) = @_;
    $self->lex unless $nolex;
    $token = [ $token ]		unless ref $token;
    foreach (@{ $token }) {
	if (ref $_) {
	    next unless $self->{_token} eq WORD;
	    foreach (@$_) {
		return if $_ eq $self->{_data};
	    }
	    $self->choke("Invalid identifier `", $self->{_data}, "' at ",
			 $self->where);
	} else {
	    return if $_ eq $self->{_token};
	}
    }
    if (@{ $token } == 1) {
	$token = ${ $token }[0];
	$token = WORD if ref $token;
	$self->choke("Expected ", t2n($token, 1), ", saw ",
		     $self->t2d, " $mess at ", $self->where);
    } else {
	$self->choke("Unexpected ", t2n($self->{_token}), " (",
		     $self->t2d, ") $mess at ", $self->where);
    }
}

sub open_file($$) {
    require IO::File;
    my $self = shift;
    my($file) = @_;
    $self->{_fh} = IO::File->new($file, "r")
			or croak "Unable to open $file for reading: $!";
    $self->{_file} = $file;
}

sub parse_bool($$) {
    my($self, $mess) = @_;
    $self->expect([ WORD, STRING, NUMBER ], $mess);
    my($value) = {
	"yes"	=> 1,
	"no"	=> 0,
	"true"	=> 1,
	"false"	=> 0,
	"1"	=> 1,
	"0"	=> 0,
    }->{$self->{_data}};
    return $value if defined $value;
    $self->choke("Expected a boolean, saw `", $self->{_data}, "' at ",
		 $self->where);
}
sub parse_addrmatchlist($$;$) {
    my($self, $mess, $nolex) = @_;
    $self->expect('{', $mess, $nolex);
    my(@items, $negated, $data);
    while(1) {
	$negated = 0;
	$self->expect([ IPADDR, NUMBER, WORD, STRING, '!', '{', '}' ], $mess);
	last if $self->{_token} eq '}';
	if ($self->{_token} eq '!') {
	    $negated = 1;
	    $self->expect([ IPADDR, NUMBER, WORD, STRING, '{' ],
			  "following `!'");
	}
	if ($self->{_token} eq '{') {
	    push @items, [ $negated, $self->parse_addrmatchlist($mess, 1) ];
	    next
	}
	if ($self->{_token} eq WORD || $self->{_token} eq STRING) {
	    push @items, [ $negated, "acl", $self->{_data} ];
	    next
	}
	$data = $self->{_data};
	$self->expect( $self->{_token} eq NUMBER ? '/' : [ '/', ';' ], $mess);
	if ($self->{_token} eq ';') {
	    push @items, [ $negated, $data ];
	    redo	# we already slurped the ';'
	}
	$self->expect(NUMBER, "following `/'");
	push @items, [ $negated, $data, $self->{_data} ];
    } continue {
	$self->expect(';', $mess);
    }
    return \@items
}
sub parse_addrlist($$) {
    my($self, $mess) = @_;
    $self->expect('{', $mess);
    my(@addrs);
    while (1) {
	$self->expect([ IPADDR, '}' ], $mess);
	last if $self->{_token} eq '}';
	push @addrs, $self->{_data};
	$self->expect(';', "reading address list");
    }
    return \@addrs;
#    return \@addrs	if @addrs;
#    $self->choke("Expected at least one IP address, saw none at ",
#		 $self->where);
}
sub parse_size($$) {
    my($self, $mess) = @_;
    $self->expect([ WORD, STRING ], $mess);
    my($data) = $self->{_data};
    if ($data =~ /^(\d+)([kmg])$/i) {
	return $1 * {
		'k' => 1024,
		'm' => 1024*1024,
		'g' => 1024*1024*1024,
	    }->{lc($2)};
    }
    $self->choke("Expected size string, saw `$data' at ", $self->where);
}
sub parse_forward($$) {
    my($self, $mess) = @_;
    $self->expect([[qw(only first)]], $mess);
    return $self->{_data};
}
sub parse_transfer_format($$) {
    my($self, $mess) = @_;
    $self->expect([[qw(one-answer many-answers)]], $mess);
    return $self->{_data};
}
sub parse_check_names($$) {
    my($self, $mess) = @_;
    $self->expect([[qw(warn fail ignore)]], $mess);
    return $self->{_data};
}
sub parse_pubkey($$) {
    my($self, $mess) = @_;
    my($flags, $proto, $algo);
    $self->expect([ NUMBER, WORD, STRING ], $mess);
    $flags = $self->{_data};
    if ($self->{_token} ne NUMBER) {
	$flags = oct($flags) if $flags =~ /^0/;
    }
    $self->expect(NUMBER, $mess);
    $proto = $self->{_data};
    $self->expect(NUMBER, $mess);
    $algo = $self->{_data};
    $self->expect(STRING, $mess);
    return [ $flags, $proto, $algo, $self->{_data} ];
}

sub parse_logging_category($) {
    my $self = shift;
    $self->expect([ WORD, STRING ], "following `category'");
    my($name) = $self->{_data};
    $self->expect('{', "following `category $name'");
    my(@names);
    while (1) {
	$self->expect([ WORD, STRING, '}' ], "reading category `$name'");
	last if $self->{_token} eq '}';
	push @names, $self->{_data};
	$self->expect(';', "reading category `$name'");
    }
    $self->expect(';', "to finish category `$name'");
    $self->handle_logging_category($name, \@names);
}

sub parse_logging_channel($) {
    my $self = shift;
    $self->expect([ WORD, STRING ], "following `channel'");
    my($name) = $self->{_data};
    $self->expect('{', "following `channel $name'");
    my(%options, $temp);
    while (1) {
	$self->expect([ [ qw(file syslog null severity print-category
			     print-severity print-time) ], '}' ],
		      "reading channel `$name'");
	last if $self->{_token} eq '}';
	$temp = $self->{_data};
	if ($temp =~ /^print-/) {
	    $options{$temp} = $self->parse_bool("following `$temp'");
	} elsif ($temp eq "null") {
	    $self->choke("Destination already specified for channel `$name'")
			if exists $options{dest};
	    $options{dest} = "null";
	} elsif ($temp eq "file") {
	    $self->choke("Destination already specified for channel `$name'")
			if exists $options{dest};
	    $self->expect(STRING, "following `file'");
	    $options{dest} = $self->{_data};
	    while(1) {
		$self->expect([ [ qw(version size) ], ';' ],
			    "reading channel `$name' file specifier");
		last if $self->{_token} eq ';';
		if ($self->{_data} eq "size") {
		    $options{size} = $self->parse_size("following `size'");
		} else { # versions
		    $self->expect([ WORD, NUMBER ], "following `versions'");
		    if ($self->{_token} eq NUMBER) {
			$options{versions} = $self->{_data};
		    } elsif ($self->{_data} eq "unlimited") {
			$options{versions} = -1;
		    } else { $self->choke("Unexpected identifier following ",
				     "`versions' at ", $self->where);
		    }
		}
	    }
	    redo # already slurped ';'
	} elsif ($temp eq "syslog") {
	    $self->choke("Destination already specified for channel `$name'")
			if exists $options{dest};
	    $self->expect([[qw(kern user mail daemon auth syslog lpr news
			       uucp cron authpriv ftp local0 local1 local2
			       local3 local4 local5 local6 local7)]],
			  "following `syslog'");

	    $options{dest} = "syslog " . $self->{_data};
	} elsif ($temp eq "severity") {
	    $self->expect([[qw(critical error warning notice info debug
			       dynamic)]], "following `severity'");
	    $options{severity} = $self->{_data};
	    if ($options{severity} eq "debug") {
		$self->expect([ NUMBER, ';' ], "reading channel `$name'");
		if ($self->{_token} eq NUMBER) {
		    $options{severity} .= " " . $self->{_data};
		} else {
		    redo # already slurped the ';'
		}
	    }
	}
    } continue {
	$self->expect(';', "reading channel `$name'");
    }
    $self->expect(';', "to finish channel `$name'");
    $self->handle_logging_channel($name, \%options);
}

sub parse_logging($) {
    my $self = shift;
    $self->expect('{', "following `logging'");
    while (1) {
	$self->expect([ [ qw(category channel) ], '}' ],
		      "reading logging options");
	last if $self->{_token} eq '}';
	if ($self->{_data} eq "category") {
	    $self->parse_logging_category;
	} else { # channel
	    $self->parse_logging_channel;
	}
    }
    $self->expect(';', "to finish logging declaration");
}

my(%opt_table) = (
    "version"			=> STRING,
    "directory"			=> STRING,
    "named-xfer"		=> STRING,
    "dump-file"			=> STRING,
    "memstatistics-file"	=> STRING,
    "pid-file"			=> STRING,
    "statistics-file"		=> STRING,
    "auth-nxdomain"		=> \&parse_bool,
    "deallocate-on-exit"	=> \&parse_bool,
    "dialup"			=> \&parse_bool,
    "fake-iquery"		=> \&parse_bool,
    "fetch-glue"		=> \&parse_bool,
    "has-old-clients"		=> sub {
	    my($self, $mess) = @_;
	    my($arg) = $self->parse_bool("following `has-old-clients'");
	    $self->handle_option("auth-nxdomain", $arg);
	    $self->handle_option("maintain-ixfr-base", $arg);
	    $self->handle_option("rfc2308-type1", ! $arg);
	    return (0, 0, 1);
	},
    "host-statistics"		=> \&parse_bool,
    "multiple-cnames"		=> \&parse_bool,
    "notify"			=> \&parse_bool,
    "recursion"			=> \&parse_bool,
    "rfc2308-type1"		=> \&parse_bool,
    "use-id-pool"		=> \&parse_bool,
    "treat-cr-as-space"		=> \&parse_bool,
    "also-notify"		=> \&parse_addrlist,
    "forward"			=> \&parse_forward,
    "forwarders"		=> \&parse_addrlist,
    "check-names"		=> sub {
	    my($self, $mess) = @_;
	    $self->expect([[qw(master slave response)]], $mess);
	    my($type);
	    $type = $self->{_data};
	    return [$type, $self->parse_check_names($mess)
	    ];
	},
    "allow-query"		=> \&parse_addrmatchlist,
    "allow-transfer"		=> \&parse_addrmatchlist,
    "allow-recursion"		=> \&parse_addrmatchlist,
    "blackhole"			=> \&parse_addrmatchlist,
    "listen-on"			=> sub {
	    my($self, $mess) = @_;
	    $self->expect([ [ 'port' ], '{' ], $mess);
	    my($port);
	    if ($self->{_token} eq WORD) {
		$self->expect(NUMBER, "following `port'");
		$port = 0 + $self->{_data};
		$self->expect('{', $mess);
	    } else {
		$port = 53;
	    }
	    return [$port, $self->parse_addrmatchlist($mess, 1)];
	},
    "query-source"		=> sub {
	    my($self, $mess) = @_;
	    my($port, $address) = (0, 0);
	    $self->expect([[qw(port address)]], $mess);
	    if ($self->{_data} eq "address") {
		$self->expect([ IPADDR, '*' ], "following `address'");
		$address = $self->{_token} eq '*' ? 0 : $self->{_data};
		$self->expect([ [ 'port' ], ';' ], $mess);
		if ($self->{_token} eq WORD) {
		    $self->expect([ NUMBER, '*' ], "following `port'");
		    $port = $self->{_token} eq '*' ? 0 : $self->{_data};
		}
	    } else { #port
		$self->expect([ NUMBER, '*' ], "following `port'");
		$port = $self->{_token} eq '*' ? 0 : $self->{_data};
		$self->expect([ [ 'address' ], ';' ], $mess);
		if ($self->{_token} eq WORD) {
		    $self->expect([ IPADDR, '*' ], "following `address'");
		    $address = $self->{_token} eq '*' ? 0 : $self->{_data};
		}
	    }
	    # Blech.  We need to signal that we ate the ';'.
	    return ([$port, $address], $self->{_token} eq ';');
	},
    "lame-ttl"			=> NUMBER,
    "max-transfer-time-in"	=> NUMBER,
    "max-ncache-ttl"		=> NUMBER,
    "min-roots"			=> NUMBER,
    "serial-queries"		=> NUMBER,
    "transfer-format"		=> \&parse_transfer_format,
    "transfers-in"		=> NUMBER,
    "transfers-out"		=> NUMBER,
    "transfers-per-ns"		=> NUMBER,
    "transfer-source"		=> IPADDR,
    "maintain-ixfr-base"	=> \&parse_bool,
    "max-ixfr-log-size"		=> NUMBER,
    "coresize"			=> \&parse_size,
    "datasize"			=> \&parse_size,
    "files"			=> \&parse_size,
    "stacksize"			=> \&parse_size,
    "cleaning-interval"		=> NUMBER,
    "heartbeat-interval"	=> NUMBER,
    "interface-interval"	=> NUMBER,
    "statistics-interval"	=> NUMBER,
    "topology"			=> \&parse_addrmatchlist,
    "sortlist"			=> \&parse_addrmatchlist,
    "rrset-order"		=> sub {
	    my($self, $mess) = @_;
	    $self->expect('{', $mess);
	    my(@items, $class, $type, $name);
	    $mess = "while reading `rrset-order' list";
	    while(1) {
		$class = $type = "any";
		$name = "*";
		$self->expect([[qw(class type name order)], '}'], $mess);
		last if $self->{_token} eq '}';
		if ($self->{_data} eq "class") {
		    $self->expect([ WORD, STRING ], "following `class'");
		    $class = lc($self->{_data});
		    $self->expect([[qw(type name order)]], $mess);
		}
		if ($self->{_data} eq "type") {
		    $self->expect([ WORD, STRING ], "following `type'");
		    $type = lc($self->{_data});
		    $self->expect([[qw(name order)]], $mess);
		}
		if ($self->{_data} eq "name") {
		    $self->expect(STRING, "following `name'");
		    $name = lc($self->{_data});
		    $self->expect([[qw(order)]], $mess);
		}
		# Must be 'order'
		$self->expect(WORD, "following `order'");
		push(@items, [$class, $type, $name, $self->{_data}]);
		$self->expect(';', $mess);
	    }
	    return \@items;
	},
);

sub parse_key($) {
    my $self = shift;
    $self->expect([ WORD, STRING ], "following `key'");
    my($key, $algo, $secret);
    $key = $self->{_data};
    $self->expect('{', "following key name `$key'");
    $self->expect([[qw(algorithm secret)]], "reading key $key");
    if ($self->{_data} eq "secret") {
	$self->expect([ WORD, STRING ], "reading secret for key `$key'");
	$secret = $self->{_data};
	$self->expect(';', "reading key `$key'");
	$self->expect([["algorithm"]], "reading key `$key'");
	$self->expect([ WORD, STRING ], "reading algorithm for key `$key'");
	$algo = $self->{_data};
    } else {
	$self->expect([ WORD, STRING ], "reading algorithm for key `$key'");
	$algo = $self->{_data};
	$self->expect(';', "reading key `$key'");
	$self->expect([["secret"]], "reading key `$key'");
	$self->expect([ WORD, STRING ], "reading secret for key `$key'");
	$secret = $self->{_data};
    }
    $self->expect(';', "reading key `$key'");
    $self->expect('}', "reading key `$key'");
    $self->expect(';', "to finish key `$key'");
    $self->handle_key($key, $algo, $secret);
}

sub parse_controls($) {
    my $self = shift;
    $self->expect('{', "following `controls'");
    while(1) {
	$self->expect([ [ qw(inet unix) ], ';' ], "reading `controls'");
	last if $self->{_token} eq ';';
	if ($self->{_data} eq "inet") {
	    my($addr, $port);
	    $self->expect([ IPADDR, '*' ], "following `inet'");
	    $addr = $self->{_token} eq '*' ? 0 : $self->{_data};
	    $self->expect([["port"]], "following inet address");
	    $self->expect(NUMBER, "following `port'");
	    $port = 0 + $self->{_data};
	    $self->expect([["allow"]], "following port number");
	    $self->handle_control("inet", [ $addr, $port,
		$self->parse_addrmatchlist("following `allow'") ]);
	} else {		# unix
	    my($path, $perm, $owner);
	    $self->expect(STRING, "following `unix'");
	    $path = $self->{_data};
	    $self->expect([["perm"]], "following socket path");
	    $self->expect(NUMBER, "following `perm'");
	    $perm = $self->{_data};
	    $self->expect([["owner"]], "following permissions");
	    $self->expect(NUMBER, "following `owner'");
	    $owner = $self->{_data};
	    $self->expect([["group"]], "following owner name");
	    $self->expect(NUMBER, "following `group'");
	    $self->handle_control("unix",
			[ $path, $perm, $owner, $self->{_data} ]);
	}
    }
    $self->expect('}', "finishing `controls'");
}

sub parse_server($) {
    my $self = shift;
    $self->expect(IPADDR, "following `server'");
    my($addr, %options);
    $addr = $self->{_data};
    $self->expect('{', "following `server $addr'");
    while (1) {
	$self->expect([ [ qw(bogus support-ixfr transfers
			     transfer-format keys) ] , '}' ],
		      "reading server `$addr'");
	last if $self->{_token} eq '}';
	if ($self->{_data} eq "bogus") {
	   $options{bogus} = $self->parse_bool("following `bogus'");
	   next
	}
	if ($self->{_data} eq "support-ixfr") {
	   $options{"support-ixfr"} =
		$self->parse_bool("following `support-ixfr'");
	   next
	}
	if ($self->{_data} eq "transfers") {
	   $self->expect(NUMBER, "following `transfers'");
	   $options{transfers} = $self->{_data};
	   next
	}
	if ($self->{_data} eq "transfer-format") {
	   $options{"transfer-format"} =
		$self->parse_transfer_format("following `transfer-format'");
	    next
	}
	# keys
	$self->expect('{', "following `keys'");
	my(@keys);
	while (1) {
	    $self->expect([ WORD, STRING, '}' ], "reading key ids");
	    last if $self->{_token} eq '}';
	    push @keys, $self->{_data};
	}
	$options{"keys"} = \@keys;
    } continue {
	$self->expect(';', "reading server `$addr'");
    }
    $self->expect(';', "to finish server `$addr'");
    $self->handle_server($addr, \%options);
}

sub parse_trusted_keys($) {
    my $self = shift;
    $self->expect('{', "following `trusted-keys'");
    my($domain, $flags, $proto, $algo);
    while(1) {
	$self->expect([ WORD, '}' ], "while reading key for `trusted-keys'");
	last if $self->{_token} eq '}';
	$domain = $self->{_data};
	$self->handle_trusted_key($domain,
		$self->parse_pubkey("while reading key for `trusted-keys'"));
    }
    $self->expect(';', "to finish trusted-keys");
}

sub parse_zone($) {
    my $self = shift;
    my($name, $class);
    $self->expect([ WORD, STRING ], "following `zone'");
    $name = $self->{_data};
    $self->expect([ WORD, STRING, '{', ';' ], "following `zone $name'");
    if ($self->{_token} eq ';') {
	$self->handle_empty_zone($name, 'in');
	return
    } elsif ($self->{_token} eq '{') {
	$class = 'in';
    } else {
	$class = lc($self->{_data});
	$self->expect([ '{', ';' ], "following `zone $name $class'");
	if ($self->{_token} eq ';') {
	    $self->handle_empty_zone($name, $class);
	    return
	}
    }
    my(%options, $temp);
    while (1) {
	$self->expect([ [ qw(type file masters transfer-source check-names
			     allow-update allow-query allow-transfer
			     max-transfer-time-in dialup notify also-notify
			     ixfr-base pubkey forward fowarders) ],
			  STRING, '}' ], "reading zone `$name'");
	last if $self->{_token} eq '}';
	$temp = $self->{_data};
	if ($temp eq "type") {
	    $self->expect([[qw(master slave stub forward hint)]],
				"following `$temp'");
	    $options{$temp} = $self->{_data};
	    next
	}
	if ($temp eq "file" || $temp eq "ixfr-base") {
	    $self->expect([ WORD, STRING ], "following `$temp'");
	    $options{$temp} = $self->{_data};
	    next
	}
	if ($temp eq "masters" || $temp eq "also-notify" ||
		$temp eq "forwarders") {
	    $options{$temp} = $self->parse_addrlist("following `$temp'");
	    next
	}
	if ($temp eq "dialup" || $temp eq "notify") {
	    $options{$temp} = $self->parse_bool("following `$temp'");
	    next
	}
	if ($temp eq "max-transfer-time-in") {
	    $self->expect(NUMBER, "following `$temp'");
	    $options{$temp} = $self->{_data};
	    next
	}
	if ($temp eq "check-names") {
	    $options{$temp} = $self->parse_check_names("following `$temp'");
	    next
	}
	if ($temp eq "forward") {
	    $options{$temp} = $self->parse_forward("following `$temp'");
	    next
	}
	if ($temp eq "pubkey") {
	    $options{$temp} = $self->parse_pubkey("following `$temp'");
	    next
	}
	$options{$temp} = $self->parse_addrmatchlist("following `$temp'");
    } continue {
	$self->expect(';', "reading zone `$name'");
    }
    $self->expect(';', "to finish zone `$name'");
    if (! exists $options{type}) {
	$self->handle_empty_zone($name, $class, \%options);
    } else {
	$self->handle_zone($name, $class, $options{type}, \%options);
    }
}

sub parse_options($) {
    my $self = shift;
    $self->expect('{', "following `options'");
    my($type, $option, $arg, $ate_semi, $did_handle_option);
    while (1) {
	$self->expect([ WORD, '}' ], "reading options");
	last if $self->{_token} eq '}';
	$option = $self->{_data};
	$type = $opt_table{$option};
	$ate_semi = $did_handle_option = 0;
	if (ref $type) {
	    ($arg, $ate_semi, $did_handle_option) =
			&$type($self, "following `$option'");
	} else {
	    $self->expect($type, "following `$option'");
	    $arg = $self->{_data};
	}
	$self->expect(';', "following argument for option `$option'")
			unless $ate_semi;
	$self->handle_option($option, $arg)
			unless $did_handle_option;
    }
    $self->expect(';', "to finish options");
}

sub parse_conf() {
    my $self = shift;
    $self->{_curline} = '';
    $self->{_flags} = { };
    while (1) {
	$self->expect([ ENDoFILE, WORD ], "at beginning of statement");
	if ($self->{_token} eq ENDoFILE) {
	    if ($self->{_fhs} && @{$self->{_fhs}}) {
		my($pos);
		(@$self{qw(_fh _file _curline)}, $pos) =
					@{ pop @{$self->{_fhs}} };
		pos($self->{_curline}) = $pos;
		redo;
	    }
	    last;
	}
	if ($self->{_data} eq "acl") {
	    $self->expect([ WORD, STRING ], "following `acl'");
	    my($name, $amlist);
	    $name = $self->{_data};
	    $amlist = $self->parse_addrmatchlist("reading acl `$name'");
	    $self->expect(';', "to finish acl `$name'");
	    $self->handle_acl($name, $amlist);
	    next
	}
	if ($self->{_data} eq "include") {
	    $self->expect(STRING, "following `include'");
	    my($include) = $self->{_data};
	    $self->expect(';', "reading include statement");
	    push @{$self->{_fhs}},
		    [ @$self{qw(_fh _file _curline)}, pos($self->{_curline}) ];
	    $self->open_file($include);
	    next
	}
	if ($self->{_data} eq "key") {
	    $self->parse_key;
	    next
	}
	if ($self->{_data} eq "logging") {
	    if ($self->{_flags}{seen_logging}++) {
		$self->choke("Cannot redefine logging (", $self->where, ")");
	    }
	    $self->parse_logging;
	    next
	}
	if ($self->{_data} eq "options") {
	    if ($self->{_flags}{seen_options}++) {
		$self->choke("Cannot redefine options (", $self->where, ")");
	    }
	    $self->parse_options;
	    next
	}
	if ($self->{_data} eq "controls") {
	    $self->parse_controls;
	    next
	}
	if ($self->{_data} eq "server") {
	    $self->parse_server;
	    next
	}
	if ($self->{_data} eq "trusted-keys") {
	    $self->parse_trusted_keys;
	    next
	}
	if ($self->{_data} eq "zone") {
	    $self->parse_zone;
	    next
	}
	$self->choke("Unknown configuration entry `", $self->{_data}, "' at ",
		$self->where);
    }
    $self
}

# The external entry points
sub new {
    my $class = shift;
    my $self = { };
    bless $self, $class;
    $self
}

sub parse_file {
    my $self = shift;
    $self = $self->new		unless ref $self;
    $self->open_file(@_);
    $self->{_line} = 0;
    $self->parse_conf;
}

sub parse_fh {
    my $self = shift;
    $self = $self->new		unless ref $self;
    $self->{_fh} = shift;
    $self->{_file} = @_ ? shift : "a file handle";
    $self->{_line} = 0;
    $self->parse_conf;
}

sub parse {
    require IO::Scalar;
    my $self = shift;
    my $scalar = shift;
    $self = $self->new		unless ref $self;
    $self->{_fh} = IO::Scalar->new(\$scalar);
    $self->{_file} = @_ ? shift : "a scalar";
    $self->{_line} = 0;
    $self->parse_conf;
}

# The callbacks
sub handle_logging_category {};	# $name, \@names
sub handle_logging_channel {};	# $name, \%options
sub handle_key {};		# $name, $algo, $secret
sub handle_acl {};		# $name, $addrmatchlist
sub handle_option {};		# $option, $argument
sub handle_server {};		# $name, \%options
sub handle_trusted_key {};	# $domain, [ $flags, $proto, $algo, $keydata ]
sub handle_empty_zone {};	# $name, $class, \%options
sub handle_zone {};		# $name, $class, $type, \%options
sub handle_control {};		# $socket_type, \@type_specific_data

1;

__END__