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


line stmt bran cond sub pod time code
1             package Device::PaloAlto::Firewall;
2              
3 6     6   368221 use 5.006;
  6         20  
4 6     6   30 use strict;
  6         10  
  6         101  
5 6     6   24 use warnings;
  6         14  
  6         207  
6              
7             our $VERSION = '0.09'; # VERSION - generated by DZP::OurPkgVersion
8              
9 6     6   1896 use Device::PaloAlto::Firewall::Test;
  6         17  
  6         213  
10              
11 6     6   44 use Moose;
  6         12  
  6         36  
12 6     6   24814 use Modern::Perl;
  6         15  
  6         52  
13 6     6   4028 use LWP::UserAgent;
  6         112050  
  6         195  
14 6     6   48 use HTTP::Request;
  6         811  
  6         150  
15 6     6   28 use Carp;
  6         11  
  6         344  
16 6     6   34 use Params::Validate qw(:all);
  6         11  
  6         961  
17 6     6   34 use URI;
  6         14  
  6         113  
18 6     6   10135 use XML::Twig;
  0            
  0            
19             use Memoize qw{memoize unmemoize};
20              
21             use Data::Dumper;
22              
23             =head1 NAME
24              
25             Device::PaloAlto::Firewall - Interact with the Palo Alto firewall API
26              
27             =head1 VERSION
28              
29             version 0.09
30              
31             =cut
32              
33             =head1 SYNOPSIS
34              
35             Device::PaloAlto::Firewall provides interfaces to B<retrieve> information from a Palo Alto firewall.
36              
37             my $firewall = Device::PaloAlto::Firewall->new(uri => 'http://localhost.localdomain', username => 'admin', password => 'complex_password')
38              
39             my $environ = $firewall->environmentals();
40             my $interfaces = $firewall->interfaces();
41              
42             A key point is that that methods only retrieve information. There are no methods within this module to modify or commit configuration.
43              
44              
45             =head1 RETURN VALUES
46              
47             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).
48              
49             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.
50              
51             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.
52              
53             =head1 CONSTRUCTOR
54              
55             The C<new()> constructor takes the following arguments:
56              
57             =over 4
58              
59             =item * C<uri> - A HTTP or HTTPS URI to the firewall.
60              
61             =item * C<username> - a username to authenticate to the device.
62              
63             =item * C<password> - a password for the username.
64              
65             =back
66              
67             =cut
68              
69             has 'user_agent' => ( is => 'ro', isa => 'LWP::UserAgent', init_arg => undef, default => sub { LWP::UserAgent->new } );
70             has 'http_request' => ( is => 'rw', isa => 'HTTP::Request', init_arg => undef, default => sub { HTTP::Request->new } );
71             has 'uri' => ( is => 'ro', writer => '_uri', required => 1);
72              
73             has 'username' => ( is => 'ro', isa => 'Str', required => 1 );
74             has 'password' => ( is => 'ro', isa => 'Str', required => 1 );
75             has '_api_key' => ( is => 'rw', init_arg => undef, default => undef );
76              
77             has 'debug' => ( is => 'rw', isa => 'Bool', default => 0);
78              
79             # These allow the calling routines to pull out the raw HTTP::Request and the raw Palo response
80             # if there's an error.
81             has '_raw_http_error' => ( is => 'rw' );
82             has '_raw_pa_error' => ( is => 'rw' );
83              
84              
85             sub BUILD {
86             my $self = shift;
87            
88             #URI string gets changed into a URI object
89             my $uri_obj = URI->new($self->uri);
90             if (!$uri_obj->has_recognized_scheme) {
91             croak "Unrecognised URI passed to constructor";
92             }
93              
94             #Set the path to API located
95             $uri_obj->path("/api/");
96             $self->_uri( $uri_obj );
97              
98             # Request method is always GET
99             $self->http_request->method( 'GET' );
100              
101             # Lower the timeout for the user agent to 15 seconds
102             $self->user_agent->timeout( 15 );
103              
104             return;
105             }
106              
107             =head1 METHODS
108              
109             =head2 META
110              
111             These methods affect the way requests are made to the firewalls.
112              
113             =head3 authenticate
114              
115             Manually authenticates to the firewall and retrieves an API key which is stored internally in the object.
116             If the authentication succeeds, returns 1. If the authentication fails or the device is not accessible, returns undef.
117              
118             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()>.
119             This is presented to the user as it useful to test for connectivity and authentication before making other requests.
120              
121             =cut
122              
123             sub authenticate {
124             my $self = shift;
125              
126             return 1 if $self->_api_key;
127              
128             $self->uri->query( "type=keygen&user=".$self->username."&password=".$self->password );
129             $self->http_request->uri( $self->uri->as_string );
130            
131             # Get the HTTP response and check it for errors
132             my $http_response = $self->_send_http_request();
133             return if !$self->_check_http_response($http_response);
134              
135             # Get the PA response (XML to a Perl Structure) from the body and check for errors
136             my $api_key_response = $self->_get_pa_response($http_response);
137             return if !$self->_check_pa_response($api_key_response);
138              
139             if (!$api_key_response or !$api_key_response->{result} or !$api_key_response->{result}->{key}) {
140             carp "API key error: no valid key in response";
141             return;
142             }
143              
144             $self->_api_key( $api_key_response->{result}->{key} );
145              
146             return 1;
147             }
148              
149              
150             =head3 verify_hostname
151              
152             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>.
153              
154             $fw->verify_hostname(1); Enable TLS peer verification
155             $fw->verify_hostname(0); Disable TLS verification
156              
157             =cut
158              
159             sub verify_hostname {
160             my $self = shift;
161             my $verify_bool = shift;
162             my $verify_mode = $verify_bool ?
163             0x01 # 'SSL_VERIFY_PEER'
164             :
165             0x00; # 'SSL_VERIFY_NONE'
166              
167             $self->user_agent->ssl_opts( verify_hostname => $verify_bool, SSL_verify_mode => $verify_mode );
168              
169             return;
170             }
171              
172             =head3 optimise
173              
174             Enables/disables the local caching of requests and responses to the firewall. This is disabled by default.
175              
176             $fw->optimise(1); # Enable optimisation
177             my $system_info = $fw->system_info(); # API call to retrieve interface information
178             $system_info = $fw->system_info(); # Information retrieved from local cache
179              
180             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.
181             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:
182            
183             $fw->optimise(1);
184             my $default_vr bgp_peers = $fw->bgp_peers(vrouter => 'default');
185             my $other_vr_bgp_peers = $fw->bgp_peers(vrouter => 'other');
186              
187             Both of these methods would make an API call to the firewall as the arguments differ.
188              
189             =cut
190              
191             sub optimise {
192             my $self = shift;
193             my $bool = shift;
194            
195             if ($bool) {
196             memoize('Device::PaloAlto::Firewall::_send_request');
197             } else {
198             unmemoize('Device::PaloAlto::Firewall::_send_request');
199             }
200              
201             return;
202             }
203              
204             =head3 tester
205              
206             Retrieves a C<Device::PaloAlto::Firewall::Test> object for this firewall.
207              
208             use Test::More;
209             my $test = Device::PaloAlto::Firewall->new(uri => 'http://remote_pa.domain', username => 'test', password => 'test')->tester();
210              
211             ok( $test->interfaces_up(interfaces => ['ethernet1/1']) );
212              
213             For more information, see the L<Device::PaloAlto::Firewall::Test> documentation.
214            
215             =cut
216              
217             sub tester {
218             my $self = shift;
219              
220             return Device::PaloAlto::Firewall::Test->new(firewall => $self);
221             }
222              
223             =head2 PLATFORM
224              
225             These methods retrieve information on the firewall platform.
226              
227             =head3 system_info
228              
229             Returns system information from the firewall.
230              
231             my $system_info = $fw->system_info();
232             say "Current Time on Firewall: $system_info->{time}";
233              
234             =cut
235              
236             sub system_info {
237             my $self = shift;
238             my $system_info = $self->_send_request(command => "<show><system><info></info></system></show>");
239              
240             return if !defined $system_info;
241              
242             return $system_info->{system};
243             }
244              
245              
246              
247             =head3 environmentals
248              
249             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.
250              
251             =cut
252              
253             sub environmentals {
254             my $self = shift;
255              
256             my $environs = $self->_send_request(command => "<show><system><environmentals></environmentals></system></show>");
257              
258             return if !defined $environs;
259              
260             # Our structure comes back looking like
261             # { $property => { $slot => { 'entry' => [ { %info } ] } } }
262             #
263             # We modify the structure to remove the redundant 'entry' and make sure
264             # Single and multiple '%info' hashes are in an arrayref
265             # { $property => { $slot => [ { %info } ] } }
266            
267             for my $property (values %{ $environs }) {
268             for my $slot (values %{ $property }) {
269             $slot = $slot->{entry};
270             }
271             }
272              
273              
274             return $environs;
275             }
276              
277              
278              
279             =head3 high_availability
280              
281             Retrieves information on the high availability status of the firewall.
282              
283             =cut
284              
285             sub high_availability {
286             my $self = shift;
287             my $ha = $self->_send_request(command => "<show><high-availability><all></all></high-availability></show>");
288              
289             return if !defined $ha;
290              
291             return {} if !%{ $ha };
292              
293             return $ha;
294             }
295              
296              
297              
298             =head3 software_check
299              
300             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
301             of all of the software available. If it cannot reach the server, an empty ARRAYREF is returned.
302              
303             =cut
304              
305             sub software_check {
306             my $self = shift;
307              
308             # Test for the 255 comms error condition we don't want to carp on
309             my $comms_error_test = sub {
310             # $_[0] is $self
311             return (
312             defined $_[0]->_raw_pa_error and
313             $_[0]->_raw_pa_error->{code} eq '255' and
314             $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check upgrade info due to generic communication error.}ms
315             );
316             };
317              
318             my $software = $self->_request_with_supressed_error(
319             command => '<request><system><software><check></check></software></system></request>',
320             test => $comms_error_test,
321             return_sup_err => sub { return {} }
322             );
323              
324             return if !defined $software;
325            
326             return [] if !%{ $software }; # Retrun an empty ARRAYREF if we receive an empty HASHREF back
327              
328              
329             return $software->{'sw-updates'}->{versions}->{entry};
330             }
331              
332              
333              
334             =head3 content_check
335              
336             Asks the firewall to make a request to the Palo Alto update server to get a list of the available content. Returns an ARRAYREF
337             of all of the content available. If it cannot reach the server, an empty ARRAYREF is returned.
338              
339             =cut
340              
341             sub content_check {
342             my $self = shift;
343              
344             # Test for the 255 comms error condition we don't want to carp on
345             my $comms_error_test = sub {
346             # $_[0] is $self
347             return (
348             defined $_[0]->_raw_pa_error and
349             $_[0]->_raw_pa_error->{code} eq '255' and
350             $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check content upgrade info due to generic communication error.}ms
351             );
352             };
353              
354             my $content= $self->_request_with_supressed_error(
355             command => '<request><content><upgrade><check></check></upgrade></content></request>',
356             test => $comms_error_test,
357             return_sup_err => sub { return {} }
358             );
359              
360             return if !defined $content;
361              
362             return [] if !%{ $content };
363              
364             return $content->{'content-updates'}->{entry};
365             }
366              
367              
368              
369             =head3 antivirus_check
370              
371             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
372             of all of the signatures available. If it cannot reach the server, an empty ARRAYREF is returned.
373              
374             =cut
375              
376             sub antivirus_check {
377             my $self = shift;
378              
379             # Test for the 255 comms error condition we don't want to carp on
380             my $comms_error_test = sub {
381             # $_[0] is $self
382             return (
383             defined $_[0]->_raw_pa_error and
384             $_[0]->_raw_pa_error->{code} eq '255' and
385             $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check content upgrade info due to generic communication error.}ms
386             );
387             };
388              
389             my $av = $self->_request_with_supressed_error(
390             command => '<request><anti-virus><upgrade><check></check></upgrade></anti-virus></request>',
391             test => $comms_error_test,
392             return_sup_err => sub { return {} }
393             );
394              
395             return if !defined $av;
396              
397             return [] if !%{ $av };
398              
399             return $av->{'content-updates'}->{entry};
400             }
401              
402              
403              
404             =head3 gp_client_check
405              
406             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
407             of all of the clients available. If it cannot reach the server, an empty ARRAYREF is returned.
408              
409             =cut
410              
411             sub gp_client_check {
412             my $self = shift;
413              
414             # Test for the 255 comms error condition we don't want to carp on
415             my $comms_error_test = sub {
416             # $_[0] is $self
417             return (
418             defined $_[0]->_raw_pa_error and
419             $_[0]->_raw_pa_error->{code} eq '255' and
420             $_[0]->_raw_pa_error->{msg}->{line} =~ m{Failed to check upgrade info due to generic communication error.}ms
421             );
422             };
423              
424             my $gp_client = $self->_request_with_supressed_error(
425             command => '<request><global-protect-client><software><check></check></software></global-protect-client></request>',
426             test => $comms_error_test,
427             return_sup_err => sub { return {} }
428             );
429              
430             return if !defined $gp_client;
431              
432             return [] if !%{ $gp_client };
433              
434             return $gp_client->{'sw-updates'}->{versions}->{entry};
435             }
436              
437              
438              
439             # This method creates a request that has the ability to supress error carping.
440             # It takes:
441             # command - the command to send to the firewall
442             # test - test for the error condition to supress
443             # return_sup_err - what to return from the supressed error condfition.
444             # It always returns undef for non supressed errors.
445             #
446             # How it works:
447             # We save the original carp to a lexial, localise 'carp' and capture the message that woud have been carped if there was an error.
448             # We then make the request, and check if there was an error
449             # * If the error test returns true, we return 'return_sup_error->()
450             # * If it was any other error, we carp what should have been and return undef.
451             # * Otherwise we return 'return_no_err->()'
452             #
453             sub _request_with_supressed_error {
454             my $self = shift;
455              
456             # The CODEREFs are each passed the following values from the function:
457             # $_[0] = $self
458             # $_[1] = $fw_return
459             # $_[2] = $carped_message
460             #
461             # By default, the captured error will return an empty ARRAYREF, and no
462             # error will return the structure from the firewall. A non-captured
463             # error always returns undef.
464             my %args = validate(@_,
465             {
466             command => { type => SCALAR },
467             test => { type => CODEREF },
468             return_sup_err => { type => CODEREF | UNDEF, default => sub { return [] } },
469             }
470             );
471              
472             {
473             my $carped_message;
474             no warnings 'redefine';
475              
476              
477             # Save the previous version of carp, and create a new version that only captures the messagse to carp.
478             my $saved_carp = \&Device::PaloAlto::Firewall::carp;
479             local *Device::PaloAlto::Firewall::carp = sub { $carped_message = $_[0] };
480              
481             # Send the command to the firewall
482             my $fw_return= $self->_send_request(command => "$args{command}");
483              
484             # If the command returned undef, there was an error. The error message is now in $carped_message.
485             if (!defined $fw_return) {
486             if ($args{test}->($self, $carped_message, $fw_return)) { # If our custom test returns true
487             return $args{return_sup_err}->($self, $fw_return, $carped_message);
488             } else {
489             $saved_carp->($carped_message);
490             return;
491             }
492             }
493              
494             return $fw_return;
495             }
496             }
497              
498              
499              
500              
501              
502             =head3 licenses
503              
504             Returns an ARRAYREF with information on the licenses installed on the firewall. Includes active and expired licenses.
505             If there are no licenses installed on the firewall, an empty ARRAYREF is returned.
506              
507             =cut
508              
509             sub licenses {
510             my $self = shift;
511              
512             my $licensing = $self->_send_request(command => '<request><license><info></info></license></request>');
513              
514             return if !defined $licensing;
515              
516             return [] if !%{ $licensing->{licenses} };
517              
518             return $licensing->{licenses}->{entry};
519             }
520              
521             =head2 NETWORK
522              
523             These methods retrieve network information from the firewall.
524              
525             =head3 interfaces
526              
527              
528             Retrieves interface information.
529              
530             =cut
531              
532             sub interfaces {
533             my $self = shift;
534             my $interfaces = $self->_send_request(command => "<show><interface>all</interface></show>");
535             return $interfaces;
536             }
537              
538              
539              
540             =head3 interface_counters_logical
541              
542             Retrieves information on the logical interface counters.
543              
544             =cut
545              
546             sub interface_counters_logical {
547             my $self = shift;
548             my $counters = $self->_send_request(command => '<show><counter><interface>all</interface></counter></show>');
549              
550             return if !defined $counters;
551              
552             my $ret = $counters->{ifnet}->{ifnet}->{entry};
553              
554             return [] if !defined $ret;
555              
556             return $ret;
557             }
558              
559              
560              
561             =head3 routing_table
562              
563             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.
564              
565             my $default_vr_table = $fw->routing_table();
566             my $corp_vr_table = $fw->routing_table(vrouter => 'corp');
567              
568             =cut
569              
570             sub routing_table {
571             my $self = shift;
572             my %args = validate(@_,
573             {
574             vrouter => { default => 'default', type => SCALAR | UNDEF },
575             }
576             );
577              
578             # TODO: Have a look at sanitising the argument passed to the firewall.
579             my $routing_table = $self->_send_request(command => "<show><routing><route><virtual-router>$args{vrouter}</virtual-router></route></routing></show>");
580             return $routing_table->{entry};
581             }
582              
583              
584              
585             =head3 bgp_peers
586              
587             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.
588              
589             my $default_vr_bgp_peers = $fw->bgp_peers();
590             my $corp_vr_bgp_peers = $fw->bgp_peers(vrouter => 'corp');
591              
592             =cut
593              
594             sub bgp_peers {
595             my $self = shift;
596             my %args = validate(@_,
597             {
598             vrouter => { default => 'default', type => SCALAR | UNDEF },
599             }
600             );
601              
602             # TODO: Have a look at sanitising the argument passed to the firewall.
603             my $bgp_peer_response = $self->_send_request(command =>
604             "<show><routing><protocol><bgp><peer><virtual-router>$args{vrouter}</virtual-router></peer></bgp></protocol></routing></show>"
605             );
606              
607             return if !defined $bgp_peer_response;
608              
609             return [] if !%{ $bgp_peer_response }; # No BGP peers configured.
610              
611             return $bgp_peer_response->{entry};
612             }
613              
614              
615              
616             =head3 bgp_rib
617              
618             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.
619              
620             my $default_vr_rib = $fw->bgp_rib();
621             my $corp_vr_rib = $fw->bgp_rib(vrouter => 'corp');
622              
623             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.
624              
625             =cut
626              
627             sub bgp_rib {
628             my $self = shift;
629             my %args = validate(@_,
630             {
631             vrouter => { default => 'default', type => SCALAR | UNDEF },
632             }
633             );
634              
635             # TODO: Have a look at sanitising the argument passed to the firewall.
636             my $bgp_rib = $self->_send_request(command =>
637             "<show><routing><protocol><bgp><loc-rib><virtual-router>$args{vrouter}</virtual-router></loc-rib></bgp></protocol></routing></show>"
638             );
639              
640             return if !defined $bgp_rib;
641              
642             # As we're only getting a single VR, there's only one array member, hence the [0].
643             my $rib_prefixes_ref = $bgp_rib->{entry}->[0]->{'loc-rib'};
644              
645             # Return and empty arrayref if there's nothing in the loc RIB.
646             return [] if !%{ $rib_prefixes_ref };
647              
648             return $rib_prefixes_ref->{member};
649             }
650              
651              
652              
653             =head3 ospf_neighbours
654              
655             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.
656              
657             If OSPF is not configured, or there are no OSPF neighbours up, an empty ARRAYREF
658              
659             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.
660              
661             =cut
662              
663             sub ospf_neighbours {
664             my $self = shift;
665             my %args = validate(@_,
666             {
667             vrouter => { default => 'default', type => SCALAR | UNDEF },
668             }
669             );
670              
671             my $ospf_neighbours = $self->_send_request(command =>
672             "<show><routing><protocol><ospf><neighbor><virtual-router>$args{vrouter}</virtual-router></neighbor></ospf></protocol></routing></show>"
673             );
674              
675             return if !defined $ospf_neighbours;
676              
677             return [] if _is_null_response($ospf_neighbours->{entry});
678              
679             return $ospf_neighbours->{entry};
680             }
681              
682              
683             =head3 pim_neighbours
684              
685             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.
686              
687             my $pim_neighbours = $fw->pim_neighbours(vrouter => 'corp');
688              
689             If PIM is not configured, or there are currently no neighbours, an empty ARRAYREF is returned.
690              
691             =cut
692              
693             sub pim_neighbours {
694             my $self = shift;
695             my %args = validate(@_,
696             {
697             vrouter => { default => 'default', type => SCALAR | UNDEF },
698             }
699             );
700              
701             my $pim_neighbours = $self->_send_request(command =>
702             "<show><routing><multicast><pim><neighbor><virtual-router>$args{vrouter}</virtual-router></neighbor></pim></multicast></routing></show>"
703             );
704              
705             return if !defined $pim_neighbours;
706              
707             return [] if !%{ $pim_neighbours };
708              
709             return $pim_neighbours->{entry};
710             }
711              
712             =head3 bfd_peers
713              
714             Returns information on BFD peers.
715              
716             =cut
717              
718             sub bfd_peers {
719             my $self = shift;
720              
721             my $bfd_peers = $self->_send_request(command => '<show><routing><bfd><summary></summary></bfd></routing></show>');
722              
723             return if !defined $bfd_peers;
724              
725             return [] if !defined $bfd_peers->{entry};
726              
727              
728             # The interfaces seem to have trailing whitespace, e.g.:
729             # $VAR1 = [ {
730             # 'status' => 'up',
731             # 'interface' => 'ethernet1/23 '
732             # }, ]
733             # We go through and remove it.
734             map { $_->{interface} =~ s{\s+$}{} } @{ $bfd_peers->{entry} };
735              
736             return $bfd_peers->{entry};
737             }
738              
739             =head2 MANAGEMENT
740              
741             These methods retrieve information on the management / operational status of the firewall.
742              
743             =head3 ntp
744              
745             Retrieves information on the current synchronisation and reachability of configured NTP peers.
746              
747             =cut
748              
749             sub ntp {
750             my $self = shift;
751             my $ntp = $self->_send_request(command => "<show><ntp></ntp></show>");
752              
753             return if !defined $ntp;
754              
755             return $ntp;
756             }
757              
758              
759              
760             =head3 panorama_status
761              
762             Returns information on the current Panorama runtime status.
763              
764             =cut
765              
766             sub panorama_status {
767             my $self = shift;
768             my @ret;
769            
770             my $panorama_status_regex = qr{
771             Panorama\s+Server\s+(?<id>\d)
772             \s+ : \s+
773             (?<ip>\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})
774             \n
775             \s+ Connected \s+ : \s+ (?<connected>\w+)
776             \n
777             \s+ HA \s state \s+ : \s+ (?<ha_state>\w+)
778             }xms;
779              
780             my $panorama_status = $self->_send_request(command => '<show><panorama-status></panorama-status></show>');
781              
782             return if !defined $panorama_status;
783              
784             return [] if ref $panorama_status eq 'HASH' and !%{ $panorama_status };
785              
786             while ($panorama_status =~ m{$panorama_status_regex}g) {
787             my %pano_peer = %+;
788             push @ret, \%pano_peer;
789             }
790              
791             return \@ret;
792             }
793              
794             =head2 SECURITY
795              
796             These methods retrieve information on the security functions of the firewall.
797              
798             =head3 ip_user_mapping
799              
800             Returns the ip to user mapping table.
801              
802             =cut
803              
804             sub ip_user_mapping {
805             my $self = shift;
806              
807             my $ip_user_mappings = $self->_send_request(command => '<show><user><ip-user-mapping><all></all></ip-user-mapping></user></show>');
808              
809             return if !defined $ip_user_mappings;
810              
811              
812             return [] if !%{ $ip_user_mappings };
813              
814             # Split the user and domain into their own keys
815             IP_USER_MAP:
816             for my $user_map (@{ $ip_user_mappings->{entry} }) {
817             if (lc $user_map->{user} eq 'unknown') {
818             $user_map->{domain} = 'unknown';
819             next IP_USER_MAP;
820             }
821              
822              
823             # Split on the backslash
824             my @domain_and_user = split(m{\\}, $user_map->{user});
825             carp "User to IP mapping contains no deliniaton ('\\') between domain and user: $user_map->{user}" if @domain_and_user != 2;
826            
827             $user_map->{domain} = $domain_and_user[0];
828             $user_map->{user} = $domain_and_user[1];
829             }
830              
831             return $ip_user_mappings->{entry};
832             }
833              
834              
835              
836             =head3 userid_server_monitor
837              
838             Returns the state of the servers used to monitor User-ID IP-to-user mappings.
839              
840             =cut
841              
842             sub userid_server_monitor {
843             my $self = shift;
844             my @ret;
845              
846             my $server_monitor = $self->_send_request(command => '<show><user><server-monitor><statistics></statistics></server-monitor></user></show>');
847              
848             return if !defined $server_monitor;
849              
850             return {} if !$server_monitor;
851              
852             # Clean up the output, turning it into an ARRARREF rather than a HASHREF keyed on the server name
853             for my $server (keys %{ $server_monitor->{entry} }) {
854             $server_monitor->{entry}->{ $server }->{name} = $server;
855             push @ret, $server_monitor->{entry}->{ $server };
856             }
857              
858             return \@ret;
859             }
860              
861              
862              
863             =head3 ike_peers
864              
865             Returns information on active IKE (Phase 1) VPN peers.
866              
867             =cut
868              
869             sub ike_peers {
870             my $self = shift;
871              
872             my $ike_peers = $self->_send_request(command => '<show><vpn><ike-sa></ike-sa></vpn></show>');
873              
874             return if !defined $ike_peers;
875              
876             return [] if !%{ $ike_peers };
877              
878             return $ike_peers->{entry};
879             }
880              
881              
882              
883             =head3 ipsec_peers
884              
885             Returns information on the active IPSEC (Phase 2) VPN peers.
886              
887             =cut
888              
889             sub ipsec_peers {
890             my $self = shift;
891              
892             my $ipsec_peers = $self->_send_request(command => '<show><vpn><ipsec-sa></ipsec-sa></vpn></show>');
893              
894             return if !defined $ipsec_peers;
895              
896             return [] if !%{ $ipsec_peers->{entries} };
897              
898             return $ipsec_peers->{entries}->{entry};
899             }
900              
901              
902              
903             =head3 vpn_tunnels
904              
905             Returns dataplane IPSEC VPN tunnel information.
906              
907             =cut
908              
909             sub vpn_tunnels {
910             my $self = shift;
911              
912             my $vpn_tunnels = $self->_send_request(command => '<show><vpn><flow></flow></vpn></show>');
913              
914             return if !defined $vpn_tunnels;
915              
916             return [] if !%{ $vpn_tunnels->{IPSec} };
917              
918             return $vpn_tunnels->{IPSec}->{entry};
919              
920             }
921              
922              
923              
924              
925              
926              
927              
928              
929             ####################
930             # Utility Functions
931             #
932             ####################
933              
934              
935             sub _send_request {
936             my $self = shift;
937             my %args = validate(@_,
938             {
939             command => 1,
940             }
941             );
942              
943             # Is the API key defined? If not, request one.
944             if (!defined $self->_api_key) {
945             return if !$self->authenticate();
946             }
947              
948             #Set up the query string and the HTTP request
949             $self->uri->query( "type=op&cmd=$args{command}&key=".$self->_api_key );
950             $self->http_request->uri( $self->uri->as_string );
951              
952             # Reset the error codes and string. These will be set if there's
953             # an error in the _check_http_response and the _check_pa_response
954             $self->_raw_http_error(undef);
955             $self->_raw_pa_error(undef);
956              
957             # Send and get the HTTP response and check it for errors
958             my $http_response = $self->_send_http_request();
959             return if !$self->_check_http_response($http_response);
960              
961             # Get the PA response (XML to a Perl Structure) from the body and check for errors
962             my $pa_response = $self->_get_pa_response($http_response);
963             return if !$self->_check_pa_response($pa_response);
964              
965             # Return the structure
966             return $pa_response->{result};
967             }
968              
969              
970              
971             sub _send_http_request {
972             my $self = shift;
973            
974             return $self->user_agent->request( $self->http_request );
975              
976             }
977              
978             sub _check_http_response {
979             my $self = shift;
980             my $http_response = shift;
981              
982             # Check the HTTP response codes
983             if ($http_response->is_error) {
984             carp "HTTP Error (".$http_response->code.")";
985              
986             $self->_raw_http_error( $http_response );
987              
988             return;
989             }
990              
991             return 1;
992             }
993              
994             sub _get_pa_response {
995             my $self = shift;
996             my $http_response = shift;
997             my $xml_parser = XML::Twig->new();
998              
999             my $pa_response_twig = $xml_parser->safe_parse( $http_response->decoded_content );
1000              
1001             if (!$pa_response_twig) {
1002             carp "Invalid XML returned from firewall";
1003             return;
1004             }
1005            
1006             my $pa_response = $pa_response_twig->simplify( forcearray => ['entry'] );
1007              
1008             return $pa_response;
1009             }
1010              
1011              
1012             sub _check_pa_response {
1013             my $self = shift;
1014             my $pa_response = shift;
1015              
1016             return if !defined $pa_response;
1017              
1018             if ($pa_response->{status} eq 'error') {
1019             # If there's no code, we create our own 'psuedo error code'
1020             $pa_response->{code} //= '255';
1021              
1022             carp "API Error: ".$self->_api_error_to_string($pa_response->{code});
1023              
1024             $self->_raw_pa_error( $pa_response );
1025              
1026             return;
1027             }
1028              
1029             return $pa_response;
1030             }
1031              
1032              
1033              
1034             sub _is_null_response {
1035             my $response = shift;
1036              
1037             if (!$response
1038             || (ref $response eq 'ARRAY' and !@{ $response })
1039             || (ref $response eq 'HASH' and !%{ $response })) {
1040             return 1;
1041             }
1042              
1043             return 0;
1044             }
1045              
1046              
1047             sub _api_error_to_string {
1048             my $self = shift;
1049             my $code = shift;
1050              
1051             return {
1052             400 => 'Bad request (400)',
1053             403 => 'Forbidden (403)',
1054             1 => 'Unknown command (1)',
1055             2 => 'Internal error (2)',
1056             3 => 'Internal error (3)',
1057             4 => 'Internal error (4)',
1058             5 => 'Internal error (5)',
1059             6 => 'Bad Xpath (6)',
1060             7 => 'Object not present (7)',
1061             8 => 'Object not unique (8)',
1062             10 => 'Reference count not zero (10)',
1063             11 => 'Internal error (11)',
1064             12 => 'Invalid object (12)',
1065             14 => 'Operation not possible (14)',
1066             15 => 'Operation denied (15)',
1067             16 => 'Unauthorized (16)',
1068             17 => 'Invalid command (17)',
1069             18 => 'Malformed (18)',
1070             19 => 'Success (19)',
1071             20 => 'Success (20)',
1072             21 => 'Internal error (21)',
1073             22 => 'Session timed out (22)',
1074             255 => 'Unknown Error Code',
1075             }->{$code};
1076             }
1077              
1078              
1079             sub _debug_print {
1080             my $self = shift;
1081             my $debug_msg = shift;
1082             my $debug_structure = shift;
1083              
1084              
1085             print STDERR $debug_msg."\n" if $self->debug == 1;
1086             print STDERR (Dumper $debug_structure) if $debug_structure;
1087              
1088             return;
1089             }
1090              
1091              
1092             =head1 AUTHOR
1093              
1094             Greg Foletta, C<< <greg at foletta.org> >>
1095              
1096             =head1 BUGS
1097              
1098             Please report any bugs or feature requests to C<bug-device-paloalto-firewall at rt.cpan.org>, or through
1099             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Device-PaloAlto-Firewall>. I will be notified, and then you'll
1100             automatically be notified of progress on your bug as I make changes.
1101              
1102              
1103              
1104              
1105             =head1 SUPPORT
1106              
1107             You can find documentation for this module with the perldoc command.
1108              
1109             perldoc Device::PaloAlto::Firewall
1110              
1111              
1112             You can also look for information at:
1113              
1114             =over 4
1115              
1116             =item * RT: CPAN's request tracker (report bugs here)
1117              
1118             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Device-PaloAlto-Firewall>
1119              
1120             =item * AnnoCPAN: Annotated CPAN documentation
1121              
1122             L<http://annocpan.org/dist/Device-PaloAlto-Firewall>
1123              
1124             =item * CPAN Ratings
1125              
1126             L<http://cpanratings.perl.org/d/Device-PaloAlto-Firewall>
1127              
1128             =item * Search CPAN
1129              
1130             L<http://search.cpan.org/dist/Device-PaloAlto-Firewall/>
1131              
1132             =back
1133              
1134              
1135             =head1 ACKNOWLEDGEMENTS
1136              
1137              
1138             =head1 LICENSE AND COPYRIGHT
1139              
1140             Copyright 2017 Greg Foletta.
1141              
1142             This program is free software; you can redistribute it and/or modify it
1143             under the terms of the the Artistic License (2.0). You may obtain a
1144             copy of the full license at:
1145              
1146             L<http://www.perlfoundation.org/artistic_license_2_0>
1147              
1148             Any use, modification, and distribution of the Standard or Modified
1149             Versions is governed by this Artistic License. By using, modifying or
1150             distributing the Package, you accept this license. Do not use, modify,
1151             or distribute the Package, if you do not accept this license.
1152              
1153             If your Modified Version has been derived from a Modified Version made
1154             by someone other than you, you are nevertheless required to ensure that
1155             your Modified Version complies with the requirements of this license.
1156              
1157             This license does not grant you the right to use any trademark, service
1158             mark, tradename, or logo of the Copyright Holder.
1159              
1160             This license includes the non-exclusive, worldwide, free-of-charge
1161             patent license to make, have made, use, offer to sell, sell, import and
1162             otherwise transfer the Package with respect to any patent claims
1163             licensable by the Copyright Holder that are necessarily infringed by the
1164             Package. If you institute patent litigation (including a cross-claim or
1165             counterclaim) against any party alleging that the Package constitutes
1166             direct or contributory patent infringement, then this Artistic License
1167             to you shall terminate on the date that such litigation is filed.
1168              
1169             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
1170             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
1171             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
1172             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
1173             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
1174             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
1175             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
1176             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1177              
1178              
1179             =cut
1180              
1181             1; # End of Device::PaloAlto::Firewall