File Coverage

blib/lib/Device/PaloAlto/Firewall/Test.pm

Criterion	Covered	Total	%
statement	29	310	9.3
branch	0	148	0.0
condition	0	18	0.0
subroutine	10	50	20.0
pod	23	23	100.0
total	62	549	11.2

package Device::PaloAlto::Firewall::Test;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.091'; # VERSION - generated by DZP::OurPkgVersion

use Moose;
use Modern::Perl;
use Carp;
use List::Util qw( any first );
#use List::MoreUtils qw( uniq );
#use Array::Utils qw{ array_minus };
use Params::Validate qw( :all );

use Data::Dumper;

=head1 NAME

Device::PaloAlto::Firewall::Test- Run a suite of tests against Palo Alto firewalls.

=head1 VERSION

version 0.091

=cut

=head1 SYNOPSIS

This module contains a set of methods that run tests against an Palo Alto firewall.
The functions take arguments and return 1 or 0 depending on the current runtime state of the firewall.

These methods should be used in conjunction with the C<ok()> function provided by C<Test::More>.
Multiple '.t' files can be created with tests for each firewall and run using the C<prove> test harness.

    use Device::PaloAlto::Firewall;
    use Test::More qw{ no_plan };

    my $tester = Device::PaloAlto::Firewall->new(uri => 'https://test_firewall.int', username => 'ro_account', password => 'complex_password)->tester();

    ok( $tester->environmentals(), "No alarms on the firewall" );
    ok( $tester->interfaces_up(interfaces => ['ethernet1/1']), "WAN interface is up");


=cut

has 'firewall'      => ( is => 'ro', isa => 'Device::PaloAlto::Firewall', default => sub { });

=head1 SUBROUTINES

=head2 Platform Tests

These methods test platform related aspects of the firewalls.

=head3 version

Takes a C<version> (as a string) and returns 1 if the firewall is running that version of PAN-OS. Returns 0 if it is running a different version.

    ok( $fw_test->version(version => '7.1.2'), "Firewall running PAN-OS 7.1.2");

Hotfixes (version suffixed with '-h1', '-h2', etc) are considered equivalent to their base versions.

=cut

sub version {
    my $self = shift;
    my %args = validate(@_,
        {
            version => { type => SCALAR },
        }
    );


    my $sysinfo = $self->firewall->system_info();

    return 0 if !defined $sysinfo;

    # Hotfixes are considered equivalent to the base version. We strip out hotfix
    # suffixes from any arguments and from the version returned from the firewall.
    my $hotfix_regex = qr{-h(\d+)$}xms;
    $sysinfo->{'sw-version'} =~ s{$hotfix_regex}{};
    $args{version} =~ s{$hotfix_regex}{};

    return 0 if !%{ $sysinfo };

    use version qw{ is_lax };

    if (!is_lax($args{version})) {
        carp "Version argument ($args{version}) is not in a valid version format, test returns 0";
        return 0;
    }

    if (!is_lax($sysinfo->{'sw-version'})) {
        carp "Version retrieved from firewall ($sysinfo->{'sw-version'}) is not in a valid version format, test returns 0";
        return 0;
    }

    return 0 if (version->parse($args{version}) > version->parse($sysinfo->{'sw-version'}));

    return 1;
}



=head3 environmentals

Returns 1 if there are no environmental alarms. These are platform dependent, but generally consist of fantray and fans, power supplies and power, and temperature. If there are B<any> alarms, returns 0.

VMs don't have any environmental information. In this instance the test will succeed, but a warning is generated.

    ok( $test->environmentals(), "No environmental alarms" );

=cut

sub environmentals {
    my $self = shift;

    my $environ = $self->firewall->environmentals();

    return 0 if !defined $environ;

    # VMs don't have any environmental info and return an empty hash.
    if (!%{ $environ }) {
        carp "No environmentals - is this a VM? Returning success";
        return 1;
    }

    for my $property (values %{ $environ }) {
        for my $slot (values %{ $property }) {
            return 0 if any { lc $_->{alarm} ne 'false' } @{ $slot };
        }
    }

    return 1;
}



=head3 licenses_active

Returns 1 if all of the licenses on the firewall are active. Returns 0 if B<any> of the licenses have expired, or if there are no licenses installed.

=cut

sub licenses_active {
    my $self = shift;

    my $licenses = $self->firewall->licenses();

    return 0 if !defined $licenses;

    return 0 if !@{ $licenses };

    for my $license (@{ $licenses }) {
        return 0 if $license->{expired} ne 'no';
    }

    return 1;
}

=head2 Network Tests

These methods test network related functions of the firewalls.

=head3 interfaces_up

C<interfaces_up> takes an ARRAYREF of interfaces are returns 1 if B<all> of the interfaces are up.  Returns 0 if B<any> of the interfaces are down.

Interfaces are matched in case insensitive manner.

    ok(
        $fw_test->interfaces_up(
            interfaces => ['ethernet1/1', 'ethernet1/2']), "Interfaces are up"
        )
    );

=cut

sub interfaces_up {
    my $self = shift;
    my %args = validate(@_,
        {
            interfaces => { type => ARRAYREF },
        }
    );

    if (!@{ $args{interfaces} }) {
        carp "Warning: no interfaces specified - test returns true";
        return 1;
    }

    my $fw_interfaces = $self->firewall->interfaces();

    return 0 if !defined $fw_interfaces;

    for my $test_interface (@{ $args{interfaces} }) {
        return 0 if !any { lc $_->{name} eq lc $test_interface and $_->{state} eq 'up' } @{ $fw_interfaces->{hw}->{entry} };
    }

    return 1;
}

=head3 interfaces_duplex


C<interfaces_duplex> takes an ARRAYREF of interfaces and returns 1 if B<all> the interfaces are in a full duplex state. Returns 0 if any of the interfaces are not in a full dupex state.
Returns 0 and warns if it detects a virtual machine as it cannot report on the duplex state.

The names of the interfaces are matched in a case-insensitive manner.

    ok(
        $fw_test->interfaces_duplex(
            interfaces => ['ethernet1/1', 'ethernet./(2|3)']
        ), "Interfaces are running full duplex"
     );

=cut

sub interfaces_duplex {
    my $self = shift;
    my %args = validate(@_,
        {
            interfaces => { type => ARRAYREF },
        }
    );

    if (!@{ $args{interfaces} }) {
            carp "Warning: no interfaces specified - test returns true";
            return 1;
    }

    my $fw_interfaces = $self->firewall->interfaces();

    return 0 if !defined $fw_interfaces;

    for my $test_interface (@{ $args{interfaces} }) {
        return 0 if !any{ _half_duplex_search($test_interface, $_) } @{ $fw_interfaces->{hw}->{entry} };
    }

    return 1;

}



# _half_duplex_search( $interface_structure_ref )
#
# Takes a "hw" interace array member returned from a firewall
# Returns 0 if the interface is:
#   * Not up
#   * A probable virtual machine interface (also warns)
#   * Is in full duplex mode
# Returns 1 for everything else. Most likely 'duplex' == 'half', but could be 'duplex' == '[n/a]'

sub _half_duplex_search {
    my $test_interface = shift;
    my $fw_interface = shift;

    return 0 if lc $test_interface ne lc $fw_interface->{name};

    return 0 if $fw_interface->{state} ne 'up';

    if ($fw_interface->{duplex} eq 'auto') {
        carp "Warning: detected 'auto' duplex, probable VM? Test will fail";
        return 0;
    }

    return 1 if $fw_interface->{duplex} eq 'full';

    return 0;
}



=head3 interface_errors_logical

Takes a C<percent> argument between (0, 100] and returns 0 if, for any interface:

=over 4

=item * The number of input errors divided by the number of input packets is greater than or equal to C<percent>, B<OR>

=item * The number of output errors divided by the number of output packets is greater than or equal to C<percent>.

=back

Otherwise it returns 1. If no C<percent> argument is supplied, it defaults to 1%.

    ok(
        $fw_test->interface_errors_logical(percent => 2), "No interfaces with more than 2% errors"
     );

=cut

sub interface_errors_logical {
    my $self = shift;
    my %args = validate(@_,
        {
            percent => {
                type => SCALAR,
                default => 1,
                callbacks => {
                    'valid_percent' => sub{ $_[0] > 0 and $_[0] <= 100; }
                },
            }
        }
    );

    my $interface_counters = $self->firewall->interface_counters_logical();

    return 0 if !defined $interface_counters;

    return 0 if !@{ $interface_counters };

    INTERFACE:
    for my $interface (@{ $interface_counters }) {
        # We don't care if the interface hasn't sent and received.
        # Also helps us avoid the divide by 0 issues.
        next INTERFACE if ($interface->{ipackets} == 0 or $interface->{opackets} == 0);

        my @percent = (
            ($interface->{ierrors} / $interface->{ipackets}) * 100,
            ($interface->{ifwderrors} / $interface->{opackets}) * 100
        );

        return 0 if $percent[0] >= $args{percent} or $percent[1] >= $args{percent};
   }

    return 1;
}


=head3 routes_exist

Takes an ARRAYREF of routes and searches for these routes in the virtual router specified by C<vrouter>.
If B<all> of the exact routes are present in the routing table it returns 1. If B<any> exact routes are not present, it
returns 0.

C<routes> is mandatory. C<vrouter> is optional, and is set to 'default' if not specified.
An empty ARRAYREF will emit a warning but will still return 1.

    ok(
        $fw_test->routes_exist(
            vrouter => 'virt_router_a',
            routes => ['192.0.2.0/30', '192.0.2.128/25']
        ), "All expected routes are present in 'virt_router_a'"
    );


=cut
sub routes_exist {
    my $self = shift;
    my %args = validate(@_,
        {
            routes      => { type => ARRAYREF },
            vrouter     => { default => 'default', type => SCALAR | UNDEF },
        }
    );

    if (!@{ $args{routes} }) {
        carp "Empty routes ARRAYREF specified - test will still return true";
        return 1;
    }

    my $route_search_ref = delete $args{routes};

    my $routing_table = $self->firewall->routing_table(%args);

    for my $route (@{ $route_search_ref }) {
        if (!grep { $route eq $_->{destination} } @{ $routing_table }) {
            return 0;
        }
    }

    return 1;
}


=head3 bgp_peers_up

Returns 1 if B<all> of the BGP peers specified in the C<peer_ips> are established. Returns 0 if any of the peers are not in the established state.

C<vrouter> specifies the virtual router that the BGP peers are configured under. If not supplied, the vrouter 'default' will be used.

    ok(
        $fw_test->bgp_peers_ip(
            vrouter => 'virt_router_a',
            peer_ips => ['192.0.2.1', '192.0.2.20']
        ), "BGP peerings for 'virt_router-a' are up"
    );



=cut

sub bgp_peers_up {
    my $self = shift;
    my %args = validate(@_,
        {
            peer_ips    => { type => ARRAYREF },
            vrouter     => { default => 'default', type => SCALAR | UNDEF },
        }
    );

    my $peer_ip_search_ref = delete $args{peer_ips};

    my $bgp_peers = $self->firewall->bgp_peers(%args);

    my @up_peers = grep { $_->{status} eq 'Established' } @{ $bgp_peers };

    # Iterate through the peer IPs passed to us and determine whether they're up.
    # If the peer is up, 'peer-address' is host:port, so we split and match against
    # the first array member
    for my $peer_search (@{ $peer_ip_search_ref }) {
        if (!grep { $peer_search eq (split(':', $_->{'peer-address'}))[0] } @up_peers ) {
                return 0;
        }
    }

    return 1;
}



=head3 bgp_prefixes_in_rib

Returns 1 if B<all> of the prefixes specified in the C<prefixes> are present in the local routing information base (RIB) for a specific C<vrouter>. Returns 0 if any of the prefixes are not present.

If C<vrouter> is not specified, the vrouter 'default' will be used.

Note that this only determines whether a prefix is present within the RIB. It doesn't take into account how many times the prefix is present or what peer it received it from. The prefix could also
have been locally originated and this would still return 1.

    ok(
        $fw_test->bgp_prefixes_in_rib(
            vrouter => 'virt_router_a',
            prefixes => ['192.168.0.0/24', '0.0.0.0/0']
        ), "Default and local private range prefixes in RIB"
    );

=cut

sub bgp_prefixes_in_rib {
    my $self = shift;
    my %args = validate(@_,
        {
            prefixes    => { type => ARRAYREF },
            vrouter     => { default => 'default', type => SCALAR | UNDEF },
        }
    );

    my $test_prefixes = delete $args{prefixes};

    my $bgp_prefixes = $self->firewall->bgp_rib(%args);

    return 0 if !$bgp_prefixes;

    return 0 if !@{ $bgp_prefixes };

    # Return 0 if the test prefix is not present in the RIB.
    for my $test_prefix (@{ $test_prefixes }) {
        return 0 if !any { $test_prefix eq $_->{prefix} } @{ $bgp_prefixes };
    }

    return 1;
}



=head3 ospf_neighbours_up

Returns 1 if B<all> of the OSPF neighbours specified in the C<neighbours> argument are up for a specific C<vrouter>. Neighbours are specified by their IP address, B<NOT> by their router ID. Returns 0 if B<any> of the neighbours are not in a 'full' state (i.e. in init/2-way/extart/exchange state), or the neighbour was not returned at all and is therefore down.

If a C<vrouter> is not specified, the vrouter 'default' will be used.

    ok(
        $fw_test->ospf_neighbours_up(
            vrouter => 'virt_router_a',
            neighbours => ['192.168.1.1', '172.16.2.1']
        ), "Expected OSPF neighbours are up"
    );

=cut

sub ospf_neighbours_up {
    my $self = shift;
    my %args = validate(@_,
        {
            neighbours  => { type => ARRAYREF },
            vrouter     => { default => 'default', type => SCALAR | UNDEF },
        }
    );

    my $test_ospf_nbrs = delete $args{neighbours};

    my $ospf_neighbours = $self->firewall->ospf_neighbours(%args);

    for my $test_ospf_nbr (@{ $test_ospf_nbrs }) {
        return 0 if !any {
            $test_ospf_nbr eq $_->{'neighbor-address'} and lc $_->{status} eq 'full'
        } @{ $ospf_neighbours };
    }

    return 1;
}




=head3 pim_neighbours_up


Returns 1 if B<all> of the PIM neighbours specified in the C<neighbours> argument are up for a specific C<vrouter>. Neighbours are specified by their IP address. are up within a specific vrouter. Returns 0 if any of the neighbours are not up.

If C<vrouter> is not specified, the vrouter 'default' will be used.

    ok(
        $fw_test->pim_neighbours_up(
            vrouter => 'virt_router_a',
            neighbours => ['192.168.1.1', '172.16.2.1']
        ), "Expected PIM adjacencies are up"
    );

=cut

sub pim_neighbours_up {
    my $self = shift;
    my %args = validate(@_,
        {
            neighbours  => { type => ARRAYREF },
            vrouter     => { default => 'default', type => SCALAR | UNDEF },
        }
    );

    my $test_pim_neighbours = delete $args{neighbours};

    my $pim_neighbours = $self->firewall->pim_neighbours(%args);

    return 0 if !defined $pim_neighbours;

    return 0 if !@{ $pim_neighbours };

    for my $test_pim_neighbour (@{ $test_pim_neighbours }) {
        return 0 if !any { $test_pim_neighbour eq $_->{Address} } @{ $pim_neighbours };
    }

    return 1;
}

=head3 bfd_peers_up

Takes an ARRAYREF of interface names and returns 1 if:

=over 4

=item * All of the interfaces have BFD sessions associated with them, and

=item * All of the BFD sessions are up.

=back

Otherwise it returns 0. If no interfaces are specified (and empty ARRAYREF), all BFD sessions are checked.

    ok(
        $fw_test->bfd_peers_up(
            interfaces => ['ethernet1/1', 'ethernet1/2']
        ), "All BFD sessions are up"
    );

=cut

sub bfd_peers_up {
    my $self = shift;
    my %args = validate(@_,
        {
            interfaces => { type => ARRAYREF, optional => 1 },
        }
    );

    my $bfd_peers = $self->firewall->bfd_peers();

    return 0 if !$bfd_peers;

    return 0 if !@{ $bfd_peers };

    my @relevant_bfd_peers;  # Filtered by $args{interfaces} (if present) or all of them


    if (defined $args{interfaces}) {
        for my $interface (@{ $args{interfaces} }) {
            my $bfd_peer_ref = first { $_->{interface} eq $interface } @{ $bfd_peers };
            # If the interface isn't returned (not configured) return 0
            return 0 if !$bfd_peer_ref;

            push @relevant_bfd_peers, $bfd_peer_ref;
        }
    } else {
        @relevant_bfd_peers = @{ $bfd_peers };
    }


    # If any peer isn't up we return 0
    return 0 if grep { lc $_->{'state-local'} ne 'up' } @relevant_bfd_peers;

    return 1;
}


=head3 ntp_synchronised

Returns 0 if the firewall is not synchronised with an NTP peer. Returns 1 if the firewall is synchronised with B<at least> one NTP peer.

    ok( $fw_test->ntp_synchronised(), "Firewall is synchronised with at least one NTP server" );

=cut

sub ntp_synchronised {
    my $self = shift;

    my $ntp_response = $self->firewall->ntp();

    return 0 if !defined $ntp_response->{synched} or $ntp_response->{synched} eq 'LOCAL';

    return 1;
}



=head3 ntp_reachable

Returns 1 if all of the configured NTP servers are reachable. Returns 0 if any of the configured NTP servers are not reachable.

    ok ( $fw_test->ntp_reachable(), "Firewall can reach all of its NTP servers" );

=cut

sub ntp_reachable {
    my $self = shift;

    my $ntp_response = $self->firewall->ntp();

    return 0 if !defined $ntp_response->{synched};

    delete $ntp_response->{synched};

    return 0 if !keys %{ $ntp_response }; # No peers configured.

    return 0 if any { $ntp_response->{$_}->{reachable} ne 'yes' } keys %{ $ntp_response }; # Any of the servers are not reachable.

    return 1;
}

=head3 panorama_connected

Returns 1 if the firewall is connectedt to B<all> of the configured Panorama management servers, otherwise it returns 0. Also returns 0 if no Panorama servers are configured.

    ok( $fw_test->panorama_connected(), "Firewall is connected to Panorama" );

=cut

sub panorama_connected {
    my $self = shift;

    my $panorama_status_ref = $self->firewall->panorama_status();

    return 0 if !$panorama_status_ref;

    return 0 if !@{ $panorama_status_ref };

    return 0 if any { lc $_->{connected} ne 'yes' } @{ $panorama_status_ref };

    return 1;
}

=head2 High Availability Tests

These methods test aspects of the high availability function of the firewalls.

=head3 ha_enabled

Returns 1 if HA is enabled on the devices. Returns if HA is not enabled.

    ok( $test->ha_enabled(), "HA is enabled on the firewall" );

=cut

sub ha_enabled {
    my $self = shift;

    my $ha_response = $self->firewall->high_availability();

    return $self->_check_ha_enabled($ha_response->{enabled});

    return 0;
}

=head3 ha_state

Returns 1 if the firewall is in the same state as the C<state> parameter passed to the function. Returns 0 if it is not, or if HA is not enabled on the device.

    ok( $test->ha_state(state => 'active'), "Firewall is in the active HA state" );
    ok( $test->ha_state(state => 'passive'), "Firewall is in the passive HA state" );


The SCALAR string passed must be either 'active' or 'passive', however it is case insensitive.

=cut

sub ha_state {
    my $self = shift;
    my %args = validate(@_,
        {
            state => { type => SCALAR, regex => qr{active|passive}i }
        }
    );

    my $ha_response = $self->firewall->high_availability();

    # Check if HA is running
    return 0 if !$self->_check_ha_enabled($ha_response->{enabled});

    return 1 if (lc $args{state} eq lc $ha_response->{group}->{'local-info'}->{state});

    return 0;
}

=head3 ha_version

Returns 1 if the app, threat, antivirus, PAN-OS and GlobalProtect versions match between the HA peers. Returns 0 if any one of these do not match, or HA is not enabled on the device.

    ok( $test->ha_version(), "HA peers have matching versions" );

=cut

sub ha_version {
    my $self = shift;

	# These are the keys from the returned hash that all need to eq 'Match'
    my @version_match_keys = qw{ url-compat threat-compat av-compat gpclient-compat build-compat vpnclient-compat app-compat };

    my $ha_response = $self->firewall->high_availability();

    # Check if HA is running
    return 0 if !$self->_check_ha_enabled($ha_response->{enabled});

	return 0 if any { lc $_ ne 'match' } @{ $ha_response->{group}->{'local-info'} }{ @version_match_keys };


    return 1;
}


=head3 ha_peer_up

Returns 1 if the peer firewall is considerd 'up', and that the HA1, heartbeat backup and HA2 connections are 'up'. Returns 0 if any one of these conditions is not 'up'.

    ok( $test->ha_peer_up(), "HA peer is up" );

=cut

sub ha_peer_up {
    my $self = shift;

    my @ha_interface_keys = qw{ conn-mgmt conn-ha1 conn-ha2 };

    my $ha_response = $self->firewall->high_availability();

    # Check if HA is running
    return 0 if !$self->_check_ha_enabled($ha_response->{enabled});

    my $peer_info = $ha_response->{group}->{'peer-info'};

    # Return 0 if the peer isn't considered 'up', or any of the HA interfaces aren't considered 'up'
    return 0 if (lc $peer_info->{'conn-status'} ne 'up') and (any { lc $_->{'conn-status'} ne 'up' } @{ $peer_info }{ @ha_interface_keys });

    return 1;
}

=head3 ha_config_sync

Returns 1 if the configuration has been successfully synchronised between the devices. Returns 0 if the configuration has not been synchronised, if config synchronisation is not enabled, or if HA is not enabled.

    ok( $test->ha_config_sync(), "Config is sync'ed between HA peers" );

=cut

sub ha_config_sync {
    my $self = shift;

    my $ha_response = $self->firewall->high_availability();

    # Check if HA is running
    return 0 if !$self->_check_ha_enabled($ha_response->{enabled});

    return 0 if (lc $ha_response->{group}->{'running-sync-enabled'} ne 'yes') and (lc $ha_response->{group}->{'running-sync'} ne 'synchronized');

    return 1;
}




# This functon is used in all of the ha_* subs to check if HA is enabled before doing any further checks.
sub _check_ha_enabled {
    my $self = shift;
    my $enabled = shift;

    return 0 if !defined $enabled;
    return 0 if $enabled ne 'yes';

    return 1;

}

=head2 Firewall Tests

These methods test the firewall/security functionality of the firewall.

=head3 ip_user_mapping

Takes a C<domain> and an ARRAYREF of C<users> as arguments. Returns 1 if there is a valid IP mapping for all of the users within the specified domain.

If no C<domain> is specified then the users are matched for any domain. If no C<domain> or C<users> are specified then it returns 1 if there is B<any> user to IP mapping, and 0 if there are none.

    ok(
        $fw_test->ip_user_mapping(
            domain => 'internal.local',
            users => ['user_a', 'user_b']
        ), "Valid User/IP mappings for user_a & user_b"
    );

=cut

sub ip_user_mapping {
    my $self = shift;
    my %args = validate(@_,
        {
            domain  => { type => SCALAR, optional => 1 },
            users   => { type => ARRAYREF, optional => 1 },
        }
    );

    my $mappings = $self->firewall->ip_user_mapping();

    return 0 if !defined $mappings;

    my @user_mappings = @{ $mappings };

    # If domain is supplied, we only want to look at users matching that domain.
    if (defined $args{domain}) {
        @user_mappings = grep { lc $_->{domain} eq lc $args{domain} } @user_mappings;
    }

    # If no users are specified, we just need to see a single user to IP mapping
    # But we're still only looking within the domain if specified.
    if (!defined $args{users}) {
        return 0 if !grep { lc $_->{type} ne 'unknown' } @user_mappings;
    }

    # Return 0 if our user isn't in the user to IP mappings
    for my $user (@{ $args{users} }) {
        return 0 if !grep { $user eq $_->{user} } @user_mappings;
    }

    return 1; # All users have an entry.
}


=head3 userid_server_monitor

Takes an ARRAYREF of C<servers> returns 1 if all of the servers are connnected. Returns 0 if B<any> of the servers are not connected. Each server must be specified as their fully qualified domain name, e.g. 'ad01.domain.int'.

If no C<servers> argument is given, returns 1 if B<all> of the servers configured are connected, and returns 0 of B<any> of the servers are not connected.

    ok(
        $fw_test->userid_server_monitor(
            servers => ['ad01.int', 'ad02.int']
        ), "AD servers reachable for UserID"
    );

=cut

sub userid_server_monitor {
	my $self = shift;
    my %args = validate(@_,
        {
            servers => { type => ARRAYREF, optional => 1 },
        }
    );

	my $server_monitor = $self->firewall->userid_server_monitor();

    return 0 if !defined $server_monitor;

    # No servers is considered a failure
    return 0 if !@{ $server_monitor };

    # If no server arg is specified, any server that's not 'connected' is a failure
    if (!defined $args{servers}) {
        return if any { lc $_->{connected} ne 'connected' } @{ $server_monitor };
    }

    for my $server (@{ $args{servers} }) {
        my $server_state = first { $server eq $_->{name} } @{ $server_monitor };
        return 0 if (!$server_state or lc $server_state->{connected} ne 'connected')
    }

    return 1;
}



=head3 vpn_tunnels_up

Takes an ARRAYREF of C<peer_ips> and returns 1 if B<all> of the VPN tunnels are up. A VPN tunnel is considered up if its phase 1 (IKE) security association up, and all of its phase 2 (IPSEC) security associations are up.

If any of the VPN tunnels are not up - including not being configured at all, then it it returns 0.

    ok(
        $fw_test->vpn_tunnels_up(
            peer_ips => ['192.168.1.1', '172.16.2.1']
        ), "3rd party VPN tunnels are up"
    );

=cut

sub vpn_tunnels_up {
    my $self = shift;
    my %args = validate(@_,
        {
            peer_ips => { type => ARRAYREF },
        }
    );

	my $vpn_tunnels = $self->firewall->vpn_tunnels();

    return 0 if !defined $vpn_tunnels;

    # No VPNs at all indicates a failure
    return 0 if !@{ $vpn_tunnels };

    for my $peer_ip (@{ $args{peer_ips} }) {
        return 0 if !any { $_->{peerip} eq $peer_ip and lc $_->{state} eq 'active' } @{ $vpn_tunnels };
    }

    return 1;
}




=head1 AUTHOR

Greg Foletta, C<< <greg at foletta.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-device-firewall-paloaltoat rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Device-PaloAlto-Firewall>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Device::PaloAlto::Firewall::Test


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Device-PaloAlto-Firewall>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Device-PaloAlto-Firewall>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Device-PaloAlto-Firewall>

=item * Search CPAN

L<http://search.cpan.org/dist/Device-PaloAlto-Firewall/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2016 Greg Foletta.

This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:

L<http://www.perlfoundation.org/artistic_license_2_0>

Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.

If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.

This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.

This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.

Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


=cut

1; # End of Device::PaloAlto::Firewall::Test