Parsing with Parse::RecDescent

Question

I'm having trouble getting the parser to correctly return the results I want. Right now I'm just starting off with a basic string to parse, but I eventually want to get to full ACL's. I'm borrowing some code I found online that does this for Cisco ASA, but his scenarios is slight different than mine so I'm not able to use the code.

Eventually I'd like to be able to match some string like below:

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... 

Here is the code:

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;

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__},"\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

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.