view release on metacpan or  search on metacpan

lib/Device/PaloAlto/Firewall/Test.pm  view on Meta::CPAN

}



# _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;