File Coverage

blib/lib/Device/PaloAlto/Firewall.pm

Criterion	Covered	Total	%
statement	33	35	94.2
branch			n/a
condition			n/a
subroutine	12	12	100.0
pod			n/a
total	45	47	95.7

 package Device::PaloAlto::Firewall;

use 5.006;
use strict;
use warnings;

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

use Device::PaloAlto::Firewall::Test;

use Moose;
use Modern::Perl;
use LWP::UserAgent;
use HTTP::Request;
use Carp;
use Params::Validate qw{:all};
use URI;
use XML::Twig;
use Memoize qw{memoize unmemoize};
use POSIX qw{strftime};
use Devel::StackTrace;

use Data::Dumper;

=head1 NAME

Device::PaloAlto::Firewall - Interact with the Palo Alto firewall API

=head1 VERSION

version 0.091

=cut

=head1 SYNOPSIS

Device::PaloAlto::Firewall provides interfaces to B<retrieve> information from a Palo Alto firewall.

    my $firewall = Device::PaloAlto::Firewall->new(uri => 'http://localhost.localdomain', username => 'admin', password => 'complex_password')

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

A key point is that that methods only retrieve information. There are no methods within this module to modify or commit configuration.


=head1 RETURN VALUES

If the methods succeed they generally return either an ARRAYREF or a HASHREF. This includes an empty ARRAYREF or HASHREF if something is not configured or there are no entries (e.g. no OSPF neighbours).

If the method fails  - either because the device is unreachable, there's an authentication issue, or the device has thrown an error - it will croak a message and return undef.

What type (ARRAYREF, HASHREF, etc) a method returns will be in each method's section, however the full data structures is not documented. They don't adhere to a strict schema, but examples for each method are provided on the L<Device::PaloAlto:Firewall::Return> page.

=head1 CONSTRUCTOR

The C<new()> constructor takes the following arguments:

=over 4

=item * C<uri> - A HTTP or HTTPS URI to the firewall.

=item * C<username> - a username to authenticate to the device.

=item * C<password> - a password for the username.

=back

=cut

has 'user_agent'            => ( is => 'ro', isa => 'LWP::UserAgent', init_arg => undef, default => sub { LWP::UserAgent->new } );
has 'uri'                   => ( is => 'ro', writer => '_uri', required => 1 );

has 'username'              => ( is => 'ro', isa => 'Str', required => 1 );
has 'password'              => ( is => 'ro', isa => 'Str', required => 1 );
has '_api_key'              => ( is => 'rw', init_arg => undef, default => undef );

has 'optimise'              => ( is => 'rw', init_arg => undef, trigger => \&_optimise_trigger, default => 0 );

has 'trace'                 => ( is => 'rw', init_arg => undef, trigger => \&_trace_trigger, default => 0 );
has '_trace_fh'             => ( is => 'rw' );
has '_trace_id'             => ( is => 'rw', default => 0 );

# These allow the calling routines to pull out the raw HTTP::Request and the raw Palo response
# if there's an error.
has '_raw_http_error'       => ( is => 'rw' );
has '_raw_pa_error'         => ( is => 'rw' );


sub BUILD {
    my $self = shift;

    #URI string gets changed into a URI object
    my $uri_obj = URI->new($self->uri);
    if (!$uri_obj->has_recognized_scheme) {
        croak "Unrecognised URI passed to constructor";
    }

    #Set the path to API located
    $uri_obj->path("/api/");
    $self->_uri( $uri_obj );

    # Lower the timeout for the user agent to 15 seconds
    $self->user_agent->timeout( 15 );

}








=head1 METHODS

=head2 META

These methods affect the way requests are made to the firewalls.

=head3 authenticate

Manually authenticates to the firewall and retrieves an API key which is stored internally in the object.
If the authentication succeeds, returns 1. If the authentication fails or the device is not accessible, returns undef.

If this isn't called explicitly, the first method to make a request to the firewall will see there is no API key and call C<authenticate()>.
This is presented to the user as it useful to test for connectivity and authentication before making other requests.

=cut

sub authenticate {
    my $self = shift;

    return 1 if $self->_api_key;

    my $http_request = HTTP::Request->new();
    $http_request->method('GET');

    $self->uri->query( "type=keygen&user=".$self->username."&password=".$self->password );
    $http_request->uri( $self->uri->as_string );

    # Get the HTTP response and check it for errors
    my $http_response = $self->_send_http_request($http_request);
    return if !$self->_check_http_response($http_response);

    # Get the PA response (XML to a Perl Structure) from the body and check for errors
    my $api_key_response = $self->_get_pa_response($http_response);
    return if !$self->_check_pa_response($api_key_response);

    if (!$api_key_response or !$api_key_response->{result} or !$api_key_response->{result}->{key}) {
        carp "API key error: no valid key in response";
        return;
    }

    $self->_api_key( $api_key_response->{result}->{key} );

    return 1;
}


=head3 verify_hostname

Enables/disables the verification of the peer certificate and hostname if 'https' is used for API calls. By default TLS peer verification is B<enabled>.

    $fw->verify_hostname(1); Enable TLS peer verification
    $fw->verify_hostname(0); Disable TLS verification

=cut

sub verify_hostname {
    my $self = shift;
    my $verify_bool = shift;
    my $verify_mode = $verify_bool ?
        0x01        # 'SSL_VERIFY_PEER'
        :
        0x00;       # 'SSL_VERIFY_NONE'

    $self->user_agent->ssl_opts( verify_hostname => $verify_bool, SSL_verify_mode => $verify_mode );

    return;
}

=head3 optimise

Enables/disables the local caching of requests and responses to the firewall. This is disabled by default.

    $fw->optimise(1);                           # Enable optimisation
    my $system_info = $fw->system_info();       # API call to retrieve interface information
    $system_info = $fw->system_info();          # Information retrieved from local cache

The first call to C<system_info()> will make an API call to the firewall and cache the result. The second request will retrieve the response from the local cache without making an API call.
Under the covers it uses C<Memoize> to cache the API request call. This means that each function & arguments receive their own cache. For example:

    $fw->optimise(1);
    my $default_vr bgp_peers = $fw->bgp_peers(vrouter => 'default');
    my $other_vr_bgp_peers = $fw->bgp_peers(vrouter => 'other');

Both of these methods would make an API call to the firewall as the arguments differ.

=cut

sub _optimise_trigger {
    my ($self, $new, $old) = @_;

    return if !($old xor $new); # Return if previous and new values are the same.

    if ($new) {
        memoize('Device::PaloAlto::Firewall::_send_request');
    } else {
        unmemoize('Device::PaloAlto::Firewall::_send_request');
    }

    return;
}

=head3 trace

Enables/disables tracing of the requests and responses to/from the firewall. If trace is set to 1, a file named <uri>_<datetime>.trace is created in the current working directory (e.g. 192.168.1.1_10-09-11_03:22:31.trace).
This file is has the string representations of the HTTP requests and responses written to it.i If trace is set to 2, a stacktrace is written as well.

As the trace represents requests/responses to/from the firewall, if the C<optimise()> method is set to 1 only B<non-cached> requests and responses are written to the file.

If the trace file cannot be opened, a warning is printed and trace reset back to 0;


=cut

sub _trace_trigger {
    my ($self, $trigger, $prev_trigger) = @_;

    return if !($trigger xor $prev_trigger);

    if ($trigger) {
        # If trigger is true, lets open the filename
        my $fh;
        my $filename = $self->uri->host() . "_" . strftime('%Y-%m-%d_%H:%M:%S', gmtime()) . ".trace";

        if (!open $fh, '>', $filename) {
                croak "Cannot open '$filename' for tracing: $!";
                $self->trace(0);
        }

        $self->_trace_fh( $fh );
    } else {
        # If trigger is false, we close the file
        close( $self->_trace_fh );
    }

}



=head3 tester

Retrieves a C<Device::PaloAlto::Firewall::Test> object for this firewall.

    use Test::More;
    my $test = Device::PaloAlto::Firewall->new(uri => 'http://remote_pa.domain', username => 'test', password => 'test')->tester();

    ok( $test->interfaces_up(interfaces => ['ethernet1/1']) );

For more information, see the L<Device::PaloAlto::Firewall::Test> documentation.

=cut

sub tester {
    my $self = shift;

    return Device::PaloAlto::Firewall::Test->new(firewall => $self);
}

=head2 PLATFORM

These methods retrieve information on the firewall platform.

=head3 system_info

Returns system information from the firewall.

    my $system_info = $fw->system_info();
    say "Current Time on Firewall: $system_info->{time}";

=cut

sub system_info {
    my $self = shift;
    my $system_info = $self->_send_request(command => "<show><system><info></info></system></show>");

    return if !defined $system_info;

    return $system_info->{system};
}



=head3 environmentals

Returns information on the system environmentals. This includes the fantray and fans, power supplies and power, temperature. B<Note:> virtual machines don't have any environmental information and won't return any information.

=cut

sub environmentals {
    my $self = shift;

    my $environs = $self->_send_request(command => "<show><system><environmentals></environmentals></system></show>");

    return if !defined $environs;

	# Our structure comes back looking like
    # { $property => { $slot => { 'entry' => [ { %info } ] } } }
    #
	# We modify the structure to remove the redundant 'entry' and make sure
	# Single and multiple '%info' hashes are in an arrayref
    # { $property => { $slot => [ { %info } ] } }

    for my $property (values %{ $environs }) {
        for my $slot (values %{ $property }) {
            $slot = $slot->{entry};
        }
    }


    return $environs;
}



=head3 high_availability

Retrieves information on the high availability status of the firewall.

=cut

sub high_availability {
    my $self = shift;
    my $ha = $self->_send_request(command => "<show><high-availability><all></all></high-availability></show>");

    return if !defined $ha;

    return {} if !%{ $ha };

    return $ha;
}



=head3 software_check

Asks the firewall to make a request to the Palo Alto update server to get a list of the available PAN-OS software. Returns an ARRAYREF
of all of the software available. If it cannot reach the server, an empty ARRAYREF is returned.

=cut

sub software_check {
    my $self = shift;

    # Test for the 255 comms error condition we don't want to carp on
    my $comms_error_test = sub {
        # $_[0] is $self
        return (
            defined $_[0]->_raw_pa_error and
            $_[0]->_raw_pa_error->{code} eq '255' and
            $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check upgrade info due to generic communication error.}ms
        );
    };

    my $software = $self->_request_with_supressed_error(
        command => '<request><system><software><check></check></software></system></request>',
        test => $comms_error_test,
		return_sup_err => sub { return {} }
    );

    return if !defined $software;

    return [] if !%{ $software }; # Retrun an empty ARRAYREF if we receive an empty HASHREF back


    return $software->{'sw-updates'}->{versions}->{entry};
}



=head3 content_check

Asks the firewall to make a request to the Palo Alto update server to get a list of the available content. Returns an ARRAYREF
of all of the content available. If it cannot reach the server, an empty ARRAYREF is returned.

=cut

sub content_check {
    my $self = shift;

    # Test for the 255 comms error condition we don't want to carp on
    my $comms_error_test = sub {
        # $_[0] is $self
        return (
            defined $_[0]->_raw_pa_error and
            $_[0]->_raw_pa_error->{code} eq '255' and
            $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check content upgrade info due to generic communication error.}ms
        );
    };

    my $content= $self->_request_with_supressed_error(
        command => '<request><content><upgrade><check></check></upgrade></content></request>',
        test => $comms_error_test,
		return_sup_err => sub { return {} }
    );

    return if !defined $content;

    return [] if !%{ $content };

    return $content->{'content-updates'}->{entry};
}



=head3 antivirus_check

Asks the firewall to make a request to the Palo Alto update server to get a list of the available antivirus signatures. Returns an ARRAYREF
of all of the signatures available. If it cannot reach the server, an empty ARRAYREF is returned.

=cut

sub antivirus_check {
    my $self = shift;

    # Test for the 255 comms error condition we don't want to carp on
    my $comms_error_test = sub {
        # $_[0] is $self
        return (
            defined $_[0]->_raw_pa_error and
            $_[0]->_raw_pa_error->{code} eq '255' and
            $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check content upgrade info due to generic communication error.}ms
        );
    };

    my $av = $self->_request_with_supressed_error(
        command => '<request><anti-virus><upgrade><check></check></upgrade></anti-virus></request>',
        test => $comms_error_test,
		return_sup_err => sub { return {} }
    );

    return if !defined $av;

    return [] if !%{ $av };

    return $av->{'content-updates'}->{entry};
}



=head3 gp_client_check

Asks the firewall to make a request to the Palo Alto update server to get a list of the GlobalProtect clients available. Returns an ARRAYREF
of all of the clients available. If it cannot reach the server, an empty ARRAYREF is returned.

=cut

sub gp_client_check {
    my $self = shift;

    # Test for the 255 comms error condition we don't want to carp on
    my $comms_error_test = sub {
        # $_[0] is $self
        return (
            defined $_[0]->_raw_pa_error and
            $_[0]->_raw_pa_error->{code} eq '255' and
            $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check upgrade info due to generic communication error.}ms
        );
    };

    my $gp_client = $self->_request_with_supressed_error(
        command => '<request><global-protect-client><software><check></check></software></global-protect-client></request>',
        test => $comms_error_test,
		return_sup_err => sub { return {} }
    );

    return if !defined $gp_client;

    return [] if !%{ $gp_client };

    return $gp_client->{'sw-updates'}->{versions}->{entry};
}



# This method creates a request that has the ability to supress error carping.
# It takes:
#   command - the command to send to the firewall
#   test - test for the error condition to supress
#   return_sup_err - what to return from the supressed error condfition.
# It always returns undef for non supressed errors.
#
# How it works:
#   We save the original carp to a lexial, localise 'carp' and capture the message that woud have been carped if there was an error.
#   We then make the request, and check if there was an error
#       * If the error test returns true, we return 'return_sup_error->()
#       * If it was any other error, we carp what should have been and return undef.
#       * Otherwise we return 'return_no_err->()'
#
sub _request_with_supressed_error {
    my $self = shift;

    # The CODEREFs are each passed the following values from the function:
    #   $_[0] = $self
    #   $_[1] = $fw_return
    #   $_[2] = $carped_message
    #
    #   By default, the captured error will return an empty ARRAYREF, and no
    #   error will return the structure from the firewall. A non-captured
    #   error always returns undef.
    my %args = validate(@_,
        {
            command         => { type => SCALAR },
            test            => { type => CODEREF },
            return_sup_err  => { type => CODEREF | UNDEF, default => sub { return [] } },
        }
    );

    {
        my $carped_message;
        no warnings 'redefine';


        # Save the previous version of carp, and create a new version that only captures the messagse to carp.
        my $saved_carp = \&Device::PaloAlto::Firewall::carp;
        local *Device::PaloAlto::Firewall::carp = sub { $carped_message = $_[0] };

        # Send the command to the firewall
        my $fw_return= $self->_send_request(command => "$args{command}");

        # If the command returned undef, there was an error. The error message is now in $carped_message.
        if (!defined $fw_return) {
            if ($args{test}->($self, $carped_message, $fw_return)) { #  If our custom test returns true
                return $args{return_sup_err}->($self, $fw_return, $carped_message);
            } else {
                $saved_carp->($carped_message);
                return;
            }
        }

        return $fw_return;
    }
}





=head3 licenses

Returns an ARRAYREF with information on the licenses installed on the firewall. Includes active and expired licenses.
If there are no licenses installed on the firewall, an empty ARRAYREF is returned.

=cut

sub licenses {
    my $self = shift;

    my $licensing = $self->_send_request(command => '<request><license><info></info></license></request>');

    return if !defined $licensing;

    return [] if !%{ $licensing->{licenses} };

    return $licensing->{licenses}->{entry};
}

=head2 NETWORK

These methods retrieve network information from the firewall.

=head3 interfaces


Retrieves interface information.

=cut

sub interfaces {
    my $self = shift;
    my $interfaces = $self->_send_request(command => "<show><interface>all</interface></show>");
	return $interfaces;
}



=head3 interface_counters_logical

Retrieves information on the logical interface counters.

=cut

sub interface_counters_logical {
    my $self = shift;
    my $counters = $self->_send_request(command => '<show><counter><interface>all</interface></counter></show>');

    return if !defined $counters;

    my $ret = $counters->{ifnet}->{ifnet}->{entry};

    return [] if !defined $ret;

    return $ret;
}



=head3 routing_table

Retrives information on the routing table for a particular virtual router. If no C<vrouter> argument is specified it retrieves the 'default' vrouter's routing table.

    my $default_vr_table = $fw->routing_table();
    my $corp_vr_table = $fw->routing_table(vrouter => 'corp');

=cut

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

    # TODO: Have a look at sanitising the argument passed to the firewall.
    my $routing_table = $self->_send_request(command => "<show><routing><route><virtual-router>$args{vrouter}</virtual-router></route></routing></show>");
	return $routing_table->{entry};
}



=head3 bgp_peers

Retrieves information on the configured BGP peers for a particular virtual router. If no C<vrouter> argument is specified it retrieves the 'default' vrouter's BGP peers.

    my $default_vr_bgp_peers = $fw->bgp_peers();
    my $corp_vr_bgp_peers = $fw->bgp_peers(vrouter => 'corp');

=cut

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

    # TODO: Have a look at sanitising the argument passed to the firewall.
    my $bgp_peer_response = $self->_send_request(command =>
        "<show><routing><protocol><bgp><peer><virtual-router>$args{vrouter}</virtual-router></peer></bgp></protocol></routing></show>"
    );

    return if !defined $bgp_peer_response;

	return [] if !%{ $bgp_peer_response }; # No BGP peers configured.

    return $bgp_peer_response->{entry};
}



=head3 bgp_rib

Retrieves information the local routing information base (RIB) for a specific virtual router. If no C<vrouter> argument is specified, the 'default' vrouter's loc RIB is returned.

    my $default_vr_rib = $fw->bgp_rib();
    my $corp_vr_rib = $fw->bgp_rib(vrouter => 'corp');

If BGP is not configured, or there are no prefixes in the local RIB, an empty ARRAYREF is returned. Otherwise an ARRAYREF is returned containing the prefixes in the local RIB.

=cut

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

    # TODO: Have a look at sanitising the argument passed to the firewall.
    my $bgp_rib = $self->_send_request(command =>
        "<show><routing><protocol><bgp><loc-rib><virtual-router>$args{vrouter}</virtual-router></loc-rib></bgp></protocol></routing></show>"
    );

    return if !defined $bgp_rib;

    # As we're only getting a single VR, there's only one array member, hence the [0].
    my $rib_prefixes_ref = $bgp_rib->{entry}->[0]->{'loc-rib'};

    # Return and empty arrayref if there's nothing in the loc RIB.
    return [] if !%{ $rib_prefixes_ref };

    return $rib_prefixes_ref->{member};
}



=head3 ospf_neighbours

Returns and ARRAYREF containing information on the current OSPF neighbours for a specific virtual router. If no C<vrouter> argument is specified, the 'default' vrouter's neighbours are returned.

If OSPF is not configured, or there are no OSPF neighbours up, an empty ARRAYREF

Neighbours are returned who have not completed a full OSPF handshake - for example they may be in EXSTART if there is an MTU mismatch on the interface.

=cut

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

    my $ospf_neighbours = $self->_send_request(command =>
        "<show><routing><protocol><ospf><neighbor><virtual-router>$args{vrouter}</virtual-router></neighbor></ospf></protocol></routing></show>"
    );

    return if !defined $ospf_neighbours;

    return [] if _is_null_response($ospf_neighbours->{entry});

    return $ospf_neighbours->{entry};
}


=head3 pim_neighbours

Retrieves information on the PIM neighbours for a specific virtual router. If no C<vrouter> argument is specified, the neighbours for the 'default' vrouter are returned.

	my $pim_neighbours = $fw->pim_neighbours(vrouter => 'corp');

If PIM is not configured, or there are currently no neighbours, an empty ARRAYREF is returned.

=cut

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

    my $pim_neighbours = $self->_send_request(command =>
        "<show><routing><multicast><pim><neighbor><virtual-router>$args{vrouter}</virtual-router></neighbor></pim></multicast></routing></show>"
    );

    return if !defined $pim_neighbours;

    return [] if !%{ $pim_neighbours };

    return $pim_neighbours->{entry};
}

=head3 bfd_peers

Returns information on BFD peers.

=cut

sub bfd_peers {
    my $self = shift;

    my $bfd_peers = $self->_send_request(command => '<show><routing><bfd><summary></summary></bfd></routing></show>');

    return if !defined $bfd_peers;

    return [] if !defined $bfd_peers->{entry};


    # The interfaces seem to have trailing whitespace, e.g.:
    # $VAR1 = [ {
    #       'status' => 'up',
    #        'interface' => 'ethernet1/23 '
    #      }, ]
	# We go through and remove it.
	map { $_->{interface} =~ s{\s+$}{} } @{ $bfd_peers->{entry} };

    return $bfd_peers->{entry};
}

=head2 MANAGEMENT

These methods retrieve information on the management / operational status of the firewall.

=head3 ntp

Retrieves information on the current synchronisation and reachability of configured NTP peers.

=cut

sub ntp {
    my $self = shift;
    my $ntp = $self->_send_request(command => "<show><ntp></ntp></show>");

	return if !defined $ntp;

	return $ntp;
}



=head3 panorama_status

Returns information on the current Panorama runtime status.

=cut

sub panorama_status {
    my $self = shift;
    my @ret;

    my $panorama_status_regex = qr{
          Panorama\s+Server\s+(?<id>\d)
          \s+ : \s+
          (?<ip>\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})
          \n
          \s+ Connected \s+ : \s+ (?<connected>\w+)
          \n
          \s+ HA \s state \s+ : \s+ (?<ha_state>\w+)
        }xms;

    my $panorama_status = $self->_send_request(command => '<show><panorama-status></panorama-status></show>');

    return if !defined $panorama_status;

    return [] if ref $panorama_status eq 'HASH' and !%{ $panorama_status };

    while ($panorama_status =~ m{$panorama_status_regex}g) {
        my %pano_peer = %+;
        push @ret, \%pano_peer;
    }

    return \@ret;
}

=head2 SECURITY

These methods retrieve information on the security functions of the firewall.

=head3 ip_user_mapping

Returns the ip to user mapping table.

=cut

sub ip_user_mapping {
    my $self = shift;

    my $ip_user_mappings = $self->_send_request(command => '<show><user><ip-user-mapping><all></all></ip-user-mapping></user></show>');

    return if !defined $ip_user_mappings;


    return [] if !%{ $ip_user_mappings };

    # Split the user and domain into their own keys
    IP_USER_MAP:
    for my $user_map (@{ $ip_user_mappings->{entry} }) {
        if (lc $user_map->{user} eq 'unknown') {
            $user_map->{domain} = 'unknown';
            next IP_USER_MAP;
        }


        # Split on the backslash
        my @domain_and_user = split(m{\\}, $user_map->{user});
        carp "User to IP mapping contains no deliniaton ('\\') between domain and user: $user_map->{user}" if @domain_and_user != 2;

        $user_map->{domain} = $domain_and_user[0];
        $user_map->{user} = $domain_and_user[1];
    }

    return $ip_user_mappings->{entry};
}



=head3 userid_server_monitor

Returns the state of the servers used to monitor User-ID IP-to-user mappings.

=cut

sub userid_server_monitor {
    my $self = shift;
    my @ret;

    my $server_monitor = $self->_send_request(command => '<show><user><server-monitor><statistics></statistics></server-monitor></user></show>');

    return if !defined $server_monitor;

    return {} if !$server_monitor;

    # Clean up the output, turning it into an ARRARREF rather than a HASHREF keyed on the server name
    for my $server (keys %{ $server_monitor->{entry} }) {
        $server_monitor->{entry}->{ $server }->{name} = $server;
        push @ret, $server_monitor->{entry}->{ $server };
    }

    return \@ret;
}



=head3 ike_peers

Returns information on active IKE (Phase 1) VPN peers.

=cut

sub ike_peers {
    my $self = shift;

    my $ike_peers = $self->_send_request(command => '<show><vpn><ike-sa></ike-sa></vpn></show>');

    return if !defined $ike_peers;

    return [] if !%{ $ike_peers };

    return $ike_peers->{entry};
}



=head3 ipsec_peers

Returns information on the active IPSEC (Phase 2) VPN peers.

=cut

sub ipsec_peers {
    my $self = shift;

    my $ipsec_peers = $self->_send_request(command => '<show><vpn><ipsec-sa></ipsec-sa></vpn></show>');

    return if !defined $ipsec_peers;

    return [] if !%{ $ipsec_peers->{entries} };

    return $ipsec_peers->{entries}->{entry};
}



=head3 vpn_tunnels

Returns dataplane IPSEC VPN tunnel information.

=cut

sub vpn_tunnels {
    my $self = shift;

    my $vpn_tunnels = $self->_send_request(command => '<show><vpn><flow></flow></vpn></show>');

    return if !defined $vpn_tunnels;

    return [] if !%{ $vpn_tunnels->{IPSec} };

    return $vpn_tunnels->{IPSec}->{entry};

}








####################
# Utility Functions
#
####################


sub _send_request {
    my $self = shift;
    my %args = validate(@_,
        {
            command => 1,
        }
    );

    my $http_request = HTTP::Request->new();
    $http_request->method('GET');

    # Is the API key defined? If not, request one.
    if (!defined $self->_api_key) {
        return if !$self->authenticate();
    }

    #Set up the query string and the HTTP request
    $self->uri->query( "type=op&cmd=$args{command}&key=".$self->_api_key );
    $http_request->uri( $self->uri->as_string );

    # Reset the error codes and string. These will be set if there's
    # an error in the _check_http_response and the _check_pa_response
    $self->_raw_http_error(undef);
    $self->_raw_pa_error(undef);

    # Send and get the HTTP response, write it to a tracefile if it's enabled,
    # and check it for errors
    my $http_response = $self->_send_http_request($http_request);
    $self->_write_tracefile($http_request, $http_response);
    return if !$self->_check_http_response($http_response);

    # Get the PA response (XML to a Perl Structure) from the body and check for errors
    my $pa_response = $self->_get_pa_response($http_response);
    return if !$self->_check_pa_response($pa_response);

    # Return the structure
    return $pa_response->{result};
}



sub _send_http_request {
    my $self = shift;
    my $http_request = shift;

    return $self->user_agent->request( $http_request );

}

sub _check_http_response {
    my $self = shift;
    my $http_response = shift;

    # Check the HTTP response codes
    if ($http_response->is_error) {
        carp "HTTP Error (".$http_response->code.")";

        $self->_raw_http_error( $http_response );

        return;
    }

    return 1;
}


sub _write_tracefile {
    my $self = shift;
    my ($http_req, $http_resp) = @_;

    # We increment the trace ID for each call
    $self->_trace_id( $self->_trace_id() + 1 );

    if ($self->trace) {
        my $fh = $self->_trace_fh();

        print $fh '=' x 10 . " ID" . $self->_trace_id . " Request " . '=' x 10 . "\n";

        print $fh $http_req->as_string();

        print $fh '=' x 10 . " ID" . $self->_trace_id . " Response " . '=' x 10 . "\n";

        print $fh $http_resp->as_string();

        if ($self->trace == 2) {
            print $fh '=' x 10 . " ID" . $self->_trace_id . " Stack Trace " . '=' x 10 . "\n";
            my $stack = Devel::StackTrace->new();
            print $fh $stack->as_string();
        }

        print $fh "\n\n";
    }
}

sub _get_pa_response {
    my $self = shift;
    my $http_response = shift;
    my $xml_parser = XML::Twig->new();

    my $pa_response_twig = $xml_parser->safe_parse( $http_response->decoded_content );

    if (!$pa_response_twig) {
        carp "Invalid XML returned from firewall";
        return;
    }

    my $pa_response = $pa_response_twig->simplify( forcearray => ['entry'] );

    return $pa_response;
}


sub _check_pa_response {
    my $self = shift;
    my $pa_response = shift;

    return if !defined $pa_response;

    if ($pa_response->{status} eq 'error') {
        # If there's no code, we create our own 'psuedo error code'
        $pa_response->{code} //= '255';

        carp "API Error: ".$self->_api_error_to_string($pa_response->{code});

        $self->_raw_pa_error( $pa_response );

        return;
    }

    return $pa_response;
}



sub _is_null_response {
    my $response = shift;

    if (!$response
        || (ref $response eq 'ARRAY' and !@{ $response })
        || (ref $response eq 'HASH' and !%{ $response })) {
        return 1;
    }

    return 0;
}


sub _api_error_to_string {
    my $self = shift;
    my $code = shift;

	return {
        400 => 'Bad request (400)',
		403 => 'Forbidden (403)',
		1 => 'Unknown command (1)',
		2 => 'Internal error (2)',
		3 => 'Internal error (3)',
		4 => 'Internal error (4)',
		5 => 'Internal error (5)',
		6 => 'Bad Xpath (6)',
		7 => 'Object not present (7)',
		8 => 'Object not unique (8)',
		10 => 'Reference count not zero (10)',
		11 => 'Internal error (11)',
		12 => 'Invalid object (12)',
		14 => 'Operation not possible (14)',
		15 => 'Operation denied (15)',
		16 => 'Unauthorized (16)',
		17 => 'Invalid command (17)',
		18 => 'Malformed (18)',
		19 => 'Success (19)',
		20 => 'Success (20)',
		21 => 'Internal error (21)',
		22 => 'Session timed out (22)',
        255 => 'Unknown Error Code',
    }->{$code};
}


sub _debug_print {
    my $self = shift;
    my $debug_msg = shift;
    my $debug_structure = shift;


    print STDERR $debug_msg."\n" if $self->debug == 1;
    print STDERR (Dumper $debug_structure) if $debug_structure;

    return;
}


=head1 AUTHOR

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

=head1 BUGS

Please report any bugs or feature requests to C<bug-device-paloalto-firewall at 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


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 2017 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