解析Parse :: RecDescent

Question

我无法让解析器正确返回我想要的结果。现在我刚开始用一个基本字符串来解析，但我最终想要获得完整的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... 

以下是代码：

Parser.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;
}

Answer 1

您忘记在问题中添加问题，但看起来您的问题是您正在调用acl_action作为解析的根规则，但acl_action仅匹配终端{{ 1}}或accept。您希望编写与整行输入匹配的规则，并改为调用该规则。