File Coverage

blib/lib/Device/Network/ConfigParser/CheckPoint/Expert.pm

Criterion	Covered	Total	%
statement	24	45	53.3
branch	0	4	0.0
condition			n/a
subroutine	9	15	60.0
pod	6	6	100.0
total	39	70	55.7

package Device::Network::ConfigParser::CheckPoint::Expert;
# ABSTRACT: Parse expert CheckPoint output.

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_line(s) { $item[1] }
        config_line: ip_route(s) { { ip_route => $item{'ip_route(s)'} } } |
                     ifconfig(s) { { ifconfig => $item{'ifconfig(s)'} } } |
                     not_parsed { $item[1] }

            ip_route: destination nexthop_ip(?) device proto(?) scope(?) source(?) metric(?) {
                {
                    destination => $item{destination},
                    next_hop => $item{'nexthop_ip(?)'},
                    device => $item{device},
                    proto => $item{proto},
                    scope => $item{'scope(?)'},
                    source => $item{'source(?)'},
                    metric => $item{'metric(?))'}
                }
            }

                destination: ipv4 cidr { { network => $item{ipv4}, cidr => $item{cidr} } } | 'default' { { network => '0.0.0.0', cidr => '0' } }
                nexthop_ip: 'via' ipv4 { $item{ipv4} }
                device: 'dev' m{[-\w]+} { $item{__PATTERN1__} }
                proto: 'proto' m{\w+} { $item{__PATTERN1__} }
                scope: 'scope' m{\w+} { $item{__PATTERN1__} }
                source: 'src' ipv4 { $item{ipv4} }
                metric: 'metric' m{\d+} { $item{__PATTERN1__} }

#  inet6(?)

            ifconfig: interface encap hw_addr(?) inet(?) inet6(s?) flag(s) mtu if_metric rx_stats tx_stats rx_bytes tx_bytes {
                {
                    interface => $item{interface},
                    encapsulation => $item{encap},
                    hw_addr => $item{'hw_addr(?)'},
                    inet => $item{'inet(?)'},
                    inet6 => $item{'inet6(s?)'},
                    flags => $item{'flag(s)'},
                    mtu => $item{mtu},
                    metric => $item{if_metric},
                    rx_stats => $item{rx_stats},
                    tx_stats => $item{tx_stats},
                    rx_bytes => $item{rx_bytes},
                    tx_bytes => $item{tx_bytes},
                }
            }

                interface: m{[-\w]+} { $item{__PATTERN1__} }
                encap: 'Link encap:' m{Ethernet|Local Loopback} { $item{__PATTERN1__} }
                hw_addr: 'HWaddr' m{[0-9a-f:]+} { $item{__PATTERN1__} }
                inet: inet_addr inet_bcast(?) inet_mask {
                    {
                        address => $item{inet_addr},
                        mask => $item{inet_mask},
                        broadcast => $item{'inet_bcast(?)'}
                    }
                }
                    inet_addr: 'inet addr:' ipv4 { $item{ipv4} }
                    inet_bcast: 'Bcast:' ipv4 { $item{ipv4} }
                    inet_mask: 'Mask:' netmask { $item{netmask} }
                inet6: inet6_addr inet6_mask inet6_scope {
                    {
                        address => $item{inet6_addr},
                        mask => $item{inet6_mask},
                        scope => $item{inet6_scope}
                    }
                }
                    inet6_addr: 'inet6 addr:' ipv6 { $item{ipv6} }
                    inet6_mask: '/' m{\d{1,3}} { $item{__PATTERN1__} }
                    inet6_scope: 'Scope:' m{\w+} { $item{__PATTERN1__} }

                flag: m{UP|BROADCAST|RUNNING|MULTICAST|LOOPBACK} { $item{__PATTERN1__} }
                mtu: 'MTU:' m{\d+} { $item{__PATTERN1__} }
                if_metric: 'Metric:' m{\d+} { $item{__PATTERN1__} }
                rx_stats: 'RX packets:' m{\d+} 'errors:' m{\d+} 'dropped:' m{\d+} 'overruns:' m{\d+} 'frame:' m{\d+} {
                    {
                        packets => $item{__PATTERN1__},
                        errors => $item{__PATTERN2__},
                        dropped => $item{__PATTERN3__},
                        overruns => $item{__PATTERN4__},
                        frame => $item{__PATTERN5__},
                    }
                }
                tx_stats: 'TX packets:' m{\d+} 'errors:' m{\d+} 'dropped:' m{\d+} 'overruns:' m{\d+} 'carrier:' m{\d+} 'collisions:' m{\d+} 'txqueuelen:' m{\d+}{
                    {
                        packets => $item{__PATTERN1__},
                        errors => $item{__PATTERN2__},
                        dropped => $item{__PATTERN3__},
                        overruns => $item{__PATTERN4__},
                        carrier => $item{__PATTERN5__},
                        collisions => $item{__PATTERN5__},
                        txqueuelen => $item{__PATTERN5__},
                    }
                }
                rx_bytes: 'RX bytes:' m{\d+} m{\(\d{1,}\.\d \w{1,2}\)} { $item{__PATTERN1__} }
                tx_bytes: 'TX bytes:' m{\d+} m{\(\d{1,}\.\d \w{1,2}\)} { $item{__PATTERN1__} }


        not_parsed: m{\N+} { { type => $item{__RULE__}, line => $item{__PATTERN1__} } }



        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__} }
        ipv6: m{[0-9a-f:]+} { $item{__PATTERN1__} }
        cidr: '/' m{\d{1,2}} { $item{__PATTERN1__} }
        });
}



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

    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 = {
    };

    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_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__