我很难让分析师正确返回我想要的结果。现在我刚刚开始用一条基本字符串来分析,但我最终想要完全获得ACLs。我借用一些在线找到的代码,为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
";
    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;

My Test: 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__},"
";
                    my $rule  = ref($node);
                    my $token = $next->{__VALUE__};
                    $result->{$parent_key} = $token;
                    #print $rule, " ", $result->{$rule}, "
";
                }
                push @stack, [ $next, $parent_key ];
                #push @stack, $next;
            }
        }
    }
    return $result;
}