BIND-Conf_Parser
view release on metacpan or search on metacpan
lib/BIND/Conf_Parser.pm view on Meta::CPAN
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;
lib/BIND/Conf_Parser.pm view on Meta::CPAN
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);
lib/BIND/Conf_Parser.pm view on Meta::CPAN
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 "<end of file>";
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"],
lib/BIND/Conf_Parser.pm view on Meta::CPAN
';' , [ 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};
}
lib/BIND/Conf_Parser.pm view on Meta::CPAN
$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, '{' ],
lib/BIND/Conf_Parser.pm view on Meta::CPAN
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 '}';
lib/BIND/Conf_Parser.pm view on Meta::CPAN
}
}
}
} 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;
lib/BIND/Conf_Parser.pm view on Meta::CPAN
}
# 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'");
lib/BIND/Conf_Parser.pm view on Meta::CPAN
$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");
lib/BIND/Conf_Parser.pm view on Meta::CPAN
$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 '}';
lib/BIND/Conf_Parser.pm view on Meta::CPAN
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';
lib/BIND/Conf_Parser.pm view on Meta::CPAN
$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) {
lib/BIND/Conf_Parser.pm view on Meta::CPAN
$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}} };
( run in 0.705 second using v1.01-cache-2.11-cpan-65fba6d93b7 )