File Coverage

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

Criterion	Covered	Total	%
statement	44	82	53.6
branch	1	10	10.0
condition			n/a
subroutine	11	17	64.7
pod	6	6	100.0
total	62	115	53.9

package Device::Network::ConfigParser::CheckPoint::Gaia;
# ABSTRACT: Parse CheckPoint 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_line(s) { $item[1] }
        config_line:
            aaa { $item[1] } |
            arp { $item[1] } |
            bonding { $item[1] } |
            clienv { $item[1] } |
            core_dump { $item[1] } |
            dns { $item[1] } |
            domainname { $item[1] } |
            format { $item[1] } |
            hostname { $item[1] } |
            inactivity_timeout { $item[1] } |
            interface { $item[1] } |
            ipv6 { $item[1] } |
            ipv6_state { $item[1] } |
            management { $item[1] } |
            management { $item[1] } |
            max_path_splits { $item[1] } |
            message { $item[1] } |
            net_access { $item[1] } |
            ntp { $item[1] } |
            ospf { $item[1] } |
            password_controls { $item[1] } |
            pbr { $item[1] } |
            rip { $item[1] } |
            snmp { $item[1] } |
            static_route { $item[1] } |
            timezone { $item[1] } |
            tracefile { $item[1] } |
            user { $item[1] } |
            vrrp { $item[1] } |
            web { $item[1] } |
            not_config { $item[1] }

        aaa: 'set aaa' m{\N+} { { type => $item[0], config => "yes" } }
        arp: 'set arp' m{\N+} { { type => $item[0], config => "yes" } }
        bonding: 'set bonding' m{\N+} { { type => $item[0], config => "yes" } }

        clienv: 'set clienv' config_lock { { type => $item[0], config => { @{ $item[2] } } } }
            config_lock: 'config-lock' m{on|off} { [$item[0], $item[2]] }


        core_dump: 'set core-dump' m{\N+} { { type => $item[0], config => "yes" } }
        dns: 'set dns' m{\N+} { { type => $item[0], config => "yes" } }
        domainname: 'set domainname' m{\N+} { { type => $item[0], config => "yes" } }
        format: 'set format' m{\N+} { { type => $item[0], config => "yes" } }
        hostname: 'set hostname' m{\N+} { { type => $item[0], config => "yes" } }
        inactivity_timeout: 'set inactivity-timeout' m{\N+} { { type => $item[0], config => "yes" } }
        ipv6: 'set ipv6' m{\N+} { { type => $item[0], config => "yes" } }
        ipv6_state: 'set ipv6-state' m{\N+} { { type => $item[0], config => "yes" } }
        management: 'set management' m{\N+} { { type => $item[0], config => "yes" } }
        max_path_splits: 'set max-path-splits'm{\N+} { { type => $item[0], config => "yes" } }
        message: 'set message' m{\N+} { { type => $item[0], config => "yes" } }
        net_access: 'set net-access' m{\N+} { { type => $item[0], config => "yes" } }
        ntp: 'set ntp' m{\N+} { { type => $item[0], config => "yes" } }
        ospf: 'set ospf' m{\N+} { { type => $item[0], config => "yes" } }
        password_controls: 'set password-controls' m{\N+} { { type => $item[0], config => "yes" } }
        pbr: 'set pbr' m{\N+} { { type => $item[0], config => "yes" } }
        rip: 'set rip' m{\N+} { { type => $item[0], config => "yes" } }
        snmp: 'set snmp' m{\N+} { { type => $item[0], config => "yes" } }

        static_route: 'set static-route' destination (nexthop | comment) { { type => $item[0], config => { @{ $item[2] }, @{ $item[3]->[1] } } } }
            destination: m{((\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/\d{2})|default)} { [$item[0], $item[1]] }
            nexthop: 'nexthop' (nexthop_blackhole | nexthop_reject | nexthop_address | nexthop_interface) { [@{$item[2]->[1]}] }
            nexthop_blackhole: 'blackhole' { ['nexthop_type', $item[1]] }
            nexthop_reject: 'reject' { ['nexthop_type', $item[1]] }
            nexthop_address: 'gateway address' ipv4 m{on|off} { [nexthop_type => 'address', nexthop => $item[2]->[1], status => $item[3]] }
            nexthop_interface: 'gateway logical' interface_name m{on|off} { [nexthop_type => 'interface', nexthop => $item[2]->[1], status => $item[3]] }
            comment: 'comment' m{"[\w\s]+"} { [$item[0], $item[2]] }



        timezone: 'set timezone' m{\N+} { { type => $item[0], config => "yes" } }
        tracefile: 'set tracefile' m{\N+} { { type => $item[0], config => "yes" } }
        user: 'set user' m{\N+} { { type => $item[0], config => "yes" } }
        vrrp: 'set vrrp' m{\N+} { { type => $item[0], config => "yes" } }
        web: 'set web' m{\N+} { { type => $item[0], config => "yes" } }


        interface:
            'set interface' interface_name (ipv4_address_mask | vlan | state | comment | mtu | auto_negotiation | link_speed)
            { { type => $item[0], config => { name => $item[2]->[1], %{ $item[3]->[1] } } } }

            ipv4_address_mask: ipv4_address ipv4_mask { $return = { @{$item[1]}, @{$item[2]}} }
            ipv4_address: 'ipv4-address' ipv4 { [$item[0], $item[2]->[1]] }
            ipv4_mask: 'mask-length' m{\d+} { [$item[0], $item[2]] }

            vlan: 'vlan' m{\d+} { $return = { $item[0], $item[2] } }
            state: 'state' m{\S+} { $return = { $item[0], $item[2] } }
            comment: 'comments' m{"[\w\s]+"} { $return = { $item[0], $item[2] } }
            mtu: 'mtu' m{\d+} { $return = { $item[0], $item[2] } }
            auto_negotiation: 'auto-negotiation' m{\S+} { $return = { $item[0], $item[2] } }
            link_speed: 'link-speed' m{\S+} { $return = { $item[0], $item[2] } }

        # Utility definitions
        ipv4: m{\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}}
        interface_name: m{\S+}

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



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) = @_;
    my %aggregation = ();
    my %post_processed_config;

    # For each 'type' of config, (e.g. interface config), the aggregator key we're using to aggregate the separate
    # config lines together into a single hash.
    my $aggregator_keys_for = {
        interface       => q{$config_entry->{config}->{name}},
        static_route    => q{$config_entry->{config}->{destination}},
    };

    # Go through each config entry (which was originally each line of config. If there's an aggregate key defined,
    # aggregate on the 'type' and then this 'key'.
    #
    # If not, then just push it to the post processed hash.
    for my $config_entry (@{ $parsed_config }) {
        if (exists $aggregator_keys_for->{ $config_entry->{type} }) {
            my $aggregate_key = eval $aggregator_keys_for->{ $config_entry->{type} };
            @{ $aggregation{ $config_entry->{type} }{ $aggregate_key } }{ keys %{ $config_entry->{config} } } = values %{ $config_entry->{config} };
        } else {
            push @{ $post_processed_config{ $config_entry->{type} } }, $config_entry->{config};
        }
    }

    # It's of the form $aggregation{type}{key} = { #interface into }; but the key is implicitly part of the hash it points to.
    # Turn the hash of hash of hashes into a hash of array of hashes ( $aggregation{type} = [ { #interface info } ];
    for my $config_type (keys %aggregation) {
        $aggregation{ $config_type } = [ values %{ $aggregation{ $config_type } } ];
    }

    @post_processed_config{ keys %aggregation } = values %aggregation;

    return \%post_processed_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__