BIND-Conf_Parser

 view release on metacpan or  search on metacpan

lib/BIND/Conf_Parser.pm  view on Meta::CPAN

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
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

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
        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

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
        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

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
        ';'             , [ 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

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
        $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

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
            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

404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
                }
            }
        }
    } 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

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
                }
                # 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

584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
        $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

619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
            $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

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
            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

756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
        $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

781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
            $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}} };