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.081'; # 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 Data::Dumper;

=head1 NAME

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

=head1 VERSION

version 0.081

=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.

The methods return either an ARRAYREF or HASHREF, and the data structure returned is largely unchanged from what the firewall returns. Some general cleaning may
be have done, and some changes occur when the XML from the firewall is parsed and turned into a Perl structure.

For brevity, examples of the return values aren't documented within this document but in a separate 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 'http_request'  => ( is => 'rw', isa => 'HTTP::Request', init_arg => undef, default => sub { HTTP::Request->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 'debug'         => ( is => 'rw', isa => 'Bool', default => 0);


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 );

    # Request method is always GET
    $self->http_request->method( 'GET' );

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

    return;
}

=head1 METHODS

=head2 META

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

=head3 authenticate

Manually authenticates to the firewall.

=cut

sub authenticate {
    my $self = shift;

    return 1 if $self->_api_key;

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

    # Get the HTTP response and check it for errors
    my $http_response = $self->_send_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 {
    my $self = shift;
    my $bool = shift;

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

    return;
}

=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;
    return $self->_send_request(command => "<show><high-availability><all></all></high-availability></show>");
}



=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;
    return $self->_send_request(command => "<show><ntp></ntp></show>");
}



=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,
        }
    );

    # 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 );
    $self->http_request->uri( $self->uri->as_string );

    # Clear the query
    $self->uri->query(undef);

    # Send and get the HTTP response and check it for errors
    my $http_response = $self->_send_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 $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;

    return $self->user_agent->request( $self->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.")";
        return;
    }

    return 1;
}

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

    my $pa_response = $xml_parser->safe_parse( $http_response->decoded_content )->simplify( forcearray => ['entry']);

    return $pa_response;
}


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

    if ($pa_response->{status} eq 'error') {
        carp "API Error: ".$self->_api_error_to_string($pa_response->{code});
        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)',
    }->{$code} // "Unknown Error 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