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

你忘了在你的问题中包含一个问题，但看起来你的问题是你正在调用acl_action你的解析的根规则，但acl_action只匹配终端accept或deny. 您想编写一个匹配整行输入的规则，然后调用该规则。

于 2012-05-24T13:50:57.640 回答