File Coverage

blib/lib/Device/Network/ConfigParser/Cisco/ASA.pm

Criterion	Covered	Total	%
statement	29	65	44.6
branch	0	8	0.0
condition			n/a
subroutine	11	17	64.7
pod	6	6	100.0
total	46	96	47.9

package Device::Network::ConfigParser::Cisco::ASA;
# ABSTRACT: Parse Cisco ASA Configuration

use 5.006;
use strict;
use warnings;
use Modern::Perl;
use Parse::RecDescent;
use Data::Dumper;
use JSON;

use Exporter qw{import};

our @EXPORT_OK = qw{get_parser get_output_drivers parse_config post_process};


sub get_parser {
    return new Parse::RecDescent(q{

        startrule: config(s) { $item[1] }
        config:
            hostname { $item[1] } |
            domain_name { $item[1] } |
            name { $item[1] } |
            route { $item[1] } |
            acl { $item[1] } |
            nat { $item[1] } |
            object { $item[1] } |
            object_group { $item[1] } |
            not_config { $item[1] }

            hostname: 'hostname' m{\w+} { { type => $item{__RULE__}, config => $item{__PATTERN1__} } }
            domain_name: 'domain-name' m{\S+} {
                { type => $item{__RULE__}, config => $item{__PATTERN1__} }
            }

            name: 'name' ipv4 name_alias {
                { type => $item{__RULE__}, config => { ip => $item{ipv4}, alias => $item{name_alias} } }
            }

            route: 'route' interface network netmask next_hop metric track(?) {
                {   type => $item{__RULE__}, config => {
                    interface => $item{interface},
                    destination => $item{network}."/".$item{netmask},
                    next_hop => $item{next_hop},
                    metric => $item{metric},
                    track_id => @{ $item{'track(?)'} } ? $item{'track(?)'}->[0] : '',
                    }
                }
            }
                network: alias_or_ipv4 { $item[1] }
                next_hop: alias_or_ipv4 { $item[1] }
                metric: m{\d{1,3}} { $item{__PATTERN1__} }
                track: 'track' m{\d{1,3}} { $item{__PATTERN1__} }

            acl: 'access-list' m{\N+} { { type => 'acl', slurp => $item{__PATTERN1__} } }

            nat: 'nat' int_interface ext_interface source_nat destination_nat(?) proxy_arp(?) route_lookup(?) nat_description(?) {
                #use Data::Dumper;
                #print STDERR Dumper \%item;
                { type => $item{__RULE__}, config => {
                    int_interface => $item{int_interface},
                    ext_interface => $item{ext_interface},
                    source_nat => $item{source_nat},
                    destination_nat => @{ $item{'destination_nat(?)'} } ? $item{'destination_nat(?)'}->[0] : {},
                    description => @{ $item{'nat_description(?)'} } ? $item{'nat_description(?)'}->[0] : '',
                    proxy_arp => @{ $item{'proxy_arp(?)'} } ? 0 : 1,
                    route_lookup => scalar(@{ $item{'route_lookup(?)'} }),
                    }
                }
            }
                source_nat: 'source' m{static|dynamic} real_src mapped_src {
                    { type => $item{__PATTERN1__}, real_src => $item{real_src}, mapped_src => $item{mapped_src}, }
                }
                destination_nat: 'destination' m{static|dynamic} mapped_dst real_dst {
                    { type => $item{__PATTERN1__}, mapped_dst => $item{mapped_dst}, real_dst => $item{real_dst}, }
                }
                int_interface: '(' m{\w+} ',' { $item{__PATTERN1__} }
                ext_interface: m{\w+} ')' { $item{__PATTERN1__} }
                real_src: 'any' { $item[1] } | object_name { $item[1] }
                mapped_src: 'any' { $item[1] } | 'interface' { $item[1] } | object_name { $item[1] }
                mapped_dst: 'any' { $item[1] } | object_name { $item[1] }
                real_dst: 'any' { $item[1] } | object_name { $item[1] }
                nat_description: 'description' m{[ -~]+} { $item{__PATTERN1__} }
                proxy_arp: 'no-proxy-arp' { 1; }
                route_lookup: 'route-lookup' { 1; }

                object: 'object' m{network|service} object_name (0..2) {
                    #use Data::Dumper;
                    #print Dumper \%item;
                    { type => 'object', config => {
                        name => $item{object_name},
                        obj_type => $item{__PATTERN1__},
                        obj_value => $item{'$item{__PATTERN1__}_obj_body(0..2)'}
                        }
                    }
                }

                network_obj_body: 'host' ipv4 { { type => 'host', ip => $item{ipv4} } } |
                                  'range' range { { type => 'range', range_start => $item{range}->[0], range_end => $item{range}->[1] } } |
                                  'subnet' subnet { { type => 'subnet', network => $item{subnet}->[0], netmask => $item{subnet}->[1] } } |
                                  'fqdn' fqdn { { type => 'fqdn', fqdn => $item{fqdn} } } |
                                  description { { type => 'description', description => $item{description} } }

                service_obj_body: 'service' protocol description(?) { $item{protocol} } |

                                  protocol: m{\d{1,3}} { protocol => $item{__PATTERN1__} } |
                                            tcp_udp { $item[1] } |
                                            m{ah|eigrp|esp|gre|igmp|igrp|ip|ipinip|ipsec|nos|ospf|pcp|pim|pptp|sctp|snp} { { protocol => $item{__PATTERN1__} } }
                                            description { type => 'description', description => $item{description} }

                                tcp_udp: m{tcp|udp} 'destination' m{eq|gt|lt|neq|range} m{[\w-]+} {
                                    { protocol => $item{__PATTERN1__}, destination => { op => $item{__PATTERN2__}, port => $item{__PATTERN3__} } }
                                }




                object_group: 'object-group' m{network|service|protocol} object_name m{(tcp|tcp-udp|udp)?} (s?) {
                #use Data::Dumper;
                #print Dumper \%item;
                    {
                        type => $item{__RULE__},
                        name => $item{object_name},
                        obj_grp_type => $item{__PATTERN1__},
                        obj_grp_value => $item{'$item{__PATTERN1__}_obj_grp_body(s?)'},
                    }
                }

                    network_obj_grp_body:   'group-object' object_name { { type => 'group-object', group => $item{object_name} } } |
                                            'network-object host' ipv4 { { type => 'host', host => $item{ipv4} } } |
                                            'network-object' subnet { { type => 'subnet', network => $item{subnet}->[0], netmask => $item{subnet}->[1] } } |
                                            description { { type => $item{__RULE__}, description => $item{description} } }


                    service_obj_grp_body:   port_object { $item{port_object} } |
                                            group_object { $item{group_object} } |
                                            service_object { $item{service_object} } |
                                            description { { description => $item{description} } }

                        group_object: 'group-object' object_name { { type => 'group', object => $item{object_name} } }
                        port_object: 'port-object' m{eq|range} m{\N+} {
                            {
                                type => 'port',
                                op => $item{__PATTERN1__},
                                value => $item{__PATTERN2__},
                            }
                        }
                        service_object: 'service-object' m{\N+} { { type => 'service', slurp => $item{__PATTERN1__} } }


                    protocol_obj_grp_body: 'protocol' m{\N+} { { slurp => $item{__PATTERN1__} } }








        # Utility definitions, used in many placed
        ipv4: m{\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}} { $item{__PATTERN1__} }
        netmask: m{\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}} { $item{__PATTERN1__} }
        fqdn: m{[\-\w\.]+} { $item[1] }
        range: ipv4 ipv4 { [$item[1], $item[2]] }
        subnet: ipv4 netmask { [$item[1], $item[2]] }

        description: 'description' m{[ -~]+} { $item{__PATTERN1__} }

        name_alias: m{[!-~]+} { $item{__PATTERN1__} }
        object_name: m{[!-~]+} { $item{__PATTERN1__} }

        interface: m{[!-~]+} { $item{__PATTERN1__} }

        alias_or_ipv4: name_alias { $item[1] } | ipv4 { $item[1] }

        not_config: m{\N+}i {
            { type => $item[0], config => $item[1] }
        }
    });
}


sub parse_config {
    my ($parser, $config_contents) = @_;

    #$::RD_TRACE = 1;
    #$::RD_HINT = 1;

    my $parse_tree = $parser->startrule($config_contents);

    return $parse_tree;
}



sub get_output_drivers {
    return {
        csv => \&csv_output_driver,
        json => \&json_output_driver,
    };
}


sub post_process {
    my ($parsed_config) = @_;

    return $parsed_config;
}



sub csv_output_driver {
    my ($fh, $filename, $parsed_config) = @_;
    my $csv_type_driver = {
        interface       => \&_csv_interface_driver,
        static_route    => \&_csv_static_route_driver,
        not_config      => \&_csv_not_config_driver,
    };

    say "=" x 16 . "BEGIN FILE $filename" . "=" x 16;

    TYPE:
    for my $type (keys %{ $parsed_config }) {
        say "-" x 8 . "BEGIN TYPE $type" . "-" x 8;

        defined $csv_type_driver->{$type} ?
            $csv_type_driver->{$type}->($fh, $parsed_config->{$type}) :
            warn "No CSV output driver for $type\n" and next TYPE;

        say "-" x 8 . "END TYPE $type" . "-" x 8;
    }

    say "-" x 8 . "END FILE $filename" . "-" x 8;
}

sub _csv_interface_driver {
    my ($fh, $interfaces_ref) = @_;

    # Print the CSV schema line
    my @interface_properties = qw{name state vlan ipv4_address ipv4_mask auto_negotiation link_speed mtu comment};
    say $fh join(',', @interface_properties);

    # Interface through the interfaces, extract and print their properties
    for my $interface (@{ $interfaces_ref }) {
        my @properties = @{ $interface }{ @interface_properties };

        # Replace any undef with an empty string
        @properties =  map { defined $_ ? $_ : '' } @properties;
        say $fh join(',', @properties);
    }
}


sub _csv_static_route_driver {
    my ($fh, $static_routes_ref) = @_;

    my @static_route_properties = qw{destination nexthop nexthop_type status};
    say $fh join(',', @static_route_properties);

    for my $route (@{ $static_routes_ref }) {
        my @properties = @{ $route }{ @static_route_properties };

        # Replace any undef with an empty string
        @properties =  map { defined $_ ? $_ : '' } @properties;
        say $fh join(',', @properties);
    }
}


sub _csv_not_config_driver {
    my ($fh, $not_config) = @_;

    for my $config_line (@{ $not_config }) {
        print $fh "$config_line\n";
    }
}






sub json_output_driver {
    my ($fh, $filename, $parsed_config) = @_;

    print encode_json($parsed_config);
}


1; # End of Device::CheckPoint::ConfigParse

__END__