1

パーサーが必要な結果を正しく返すのに問題があります。現在、解析する基本的な文字列から始めていますが、最終的には完全な ACL に到達したいと考えています。Cisco ASA でこれを行うオンラインで見つけたコードを借りていますが、彼のシナリオは私のものとは少し異なるため、コードを使用できません。

最終的には、以下のような文字列と一致できるようにしたいと考えています。

permit ip any 1.2.0.0 0.0.255.255
permit ip host 1.2.3.4 1.2.3.4 0.0.0.31
deny   ip 138.145.211.0 0.0.0.255 any log-input
etc...

コードは次のとおりです。

パーサー.pm

package AccessList::Parser;

use 5.008008;
use strict;
use warnings;
use Carp;
use Parse::RecDescent;

our $VERSION = '0.05';

sub new {
    my ($class) = @_;
    my $self = { PARSER => undef, };
    bless $self, $class;
    $self->_init();
    return $self;
}

sub _init {
    my ($self) = @_;
    $self->{PARSER} = Parse::RecDescent->new( $self->_grammar() );
}

sub parse {
    my ( $self, $string ) = @_;
    defined ($string) or confess "blank line received";
    my $tree = $self->{PARSER}->acl_action($string);
    defined($tree) or confess "unrecognized line\n";
    return $tree;
}

sub _grammar {
    my ($self) = @_;

    my $grammar = q{
<autotree>

acl_action : "permit" | "deny"
acl_protocol :
        PROTOCOL EOL
    |   <error>

PROTOCOL :
        /\d+/ | "ah" | "eigrp" | "esp" | "gre" | "icmp" | "icmp6" | "igmp" 
    | "igrp" | "ip" | "ipinip" | "ipsec" | "nos" | "ospf" | "pcp" 
    | "pim" | "pptp" | "snp" | "tcp" | "udp"

EOL :
        /$/ 
};

    return $grammar;
}

1;

私のテスト: parse.t

use strict;
use warnings;
use Scalar::Util 'blessed';
use Test::More tests => 2;
use AccessList::Parser;

my $parser = AccessList::Parser->new();

ok( defined($parser), "constructor" );

my $string;
my $tree;
my $actual;
my $expected;

#
# Access list 1
#

$string = q{permit ip};
$tree = $parser->parse($string);
$actual = visit($tree);
$expected = {
    'acl_action'   => 'permit',
    'acl_protocol' => 'ip',
};

is_deeply($actual, $expected, "whatever");

#
# Finished tests
#

sub visit {
    my ($node) = @_;

    my $Rule_To_Key_Map = {
        "acl_action"              => 1,
        "acl_protocol"            => 1
    };

    my $parent_key;
    my $result;

    # set s of explored vertices
    my %seen;

    #stack is all neighbors of s
    my @stack;
    push @stack, [ $node, $parent_key ];

    my $key;

    while (@stack) {

        my $rec = pop @stack;

        $node       = $rec->[0];
        $parent_key = $rec->[1];    #undef for root

        next if ( $seen{$node}++ );

        my $rule_id = ref($node);

        if ( exists( $Rule_To_Key_Map->{$rule_id} ) ) {
            $parent_key = $rule_id;
        }

        foreach my $key ( keys %$node ) {
            next if ( $key eq "EOL" );
            my $next = $node->{$key};
            if ( blessed($next) ) {
                if ( exists( $next->{__VALUE__} ) ) {
                    #print ref($node), " ", ref($next), " ", $next->{__VALUE__},"\n";
                    my $rule  = ref($node);
                    my $token = $next->{__VALUE__};
                    $result->{$parent_key} = $token;
                    #print $rule, " ", $result->{$rule}, "\n";
                }
                push @stack, [ $next, $parent_key ];
                #push @stack, $next;
            }
        }
    }
    return $result;
}
4

1 に答える 1

1

You forgot to include a question in your question, but it looks like your problem is that you're calling acl_action as the root rule of your parse, but acl_action only matches the terminals accept or deny. You want to write a rule that matches an entire line of input, and call that rule instead.

于 2012-05-24T13:50:57.640 に答える