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 |