File Coverage

blib/lib/Firewall/PaloAlto.pm
Criterion Covered Total %
statement 32 213 15.0
branch 0 32 0.0
condition 0 21 0.0
subroutine 11 56 19.6
pod 12 12 100.0
total 55 334 16.4


line stmt bran cond sub pod time code
1             package Firewall::PaloAlto;
2 2     2   48869 use Moose;
  2         1065437  
  2         17  
3              
4 2     2   15477 use 5.006;
  2         9  
5 2     2   13 use strict;
  2         16  
  2         54  
6 2     2   12 use warnings;
  2         3  
  2         93  
7              
8 2     2   12225 use XML::Simple;
  2         21800  
  2         19  
9 2     2   2372 use LWP::UserAgent;
  2         111831  
  2         95  
10 2     2   30 use Carp;
  2         5  
  2         227  
11 2     2   2505 use Data::Dumper qw(Dumper);
  2         17560  
  2         229  
12 2     2   2376 use Modern::Perl;
  2         25779  
  2         20  
13 2     2   2471 use Params::Validate qw(:all);
  2         8813  
  2         1964  
14              
15              
16             =head1 NAME
17              
18             Firewall::PaloAlto - Interact with a Palo Alto firewall's API through Perl.
19              
20             =head1 VERSION
21              
22             Version 0.03
23              
24             =cut
25              
26             our $VERSION = '0.03';
27              
28             =head1 SYNOPSIS
29              
30             The Firewall::PaloAlto module provides interfaces into the XML API of a Palo Alto firewall.
31              
32             use Firewall::PaloAlto;
33              
34             my $fw = Firewall::PaloAlto->new(host => 'pa.local', username => 'admin', password => 'admin');
35             $fw->connect();
36              
37             #Add a new virtual system
38             $fw->address('set', vsys_id => 6, 'display-name' => "Script_Tenant");
39              
40             #Add a virtual router to the chassis
41             $fw->virtual_router('set', vr_name => 'NEW_VR', interface => [ 'ae1.65', 'ae1.66' ]);
42              
43             #Add a new address - if the vsys is not specified it defaults to vsys1.
44             #This works for devices such as the VM series, which only have a vsys1.
45             $fw->address('set', name => 'Google_DNS', ip-netmask => '8.8.8.8/32');
46              
47             #Get the configuration for the newly created address:
48             my $address_config = $fw->address('get', name => 'Google_DNS');
49              
50             #Delete the newly created address
51             $fw->address('delete', name => 'Google_DNS);
52              
53             A list of functions that can be exported. You can delete this section
54             if you don't export anything, such as for a purely object-oriented module.
55              
56             =cut
57              
58             =head1 CLASS METHODS
59              
60             =head2 new(%parameters)
61              
62             The constructor generates a new object to interact with a specific firewall.
63              
64             The host, username and password parameters are mandatory.
65             If not specified, SSL is used, but it can be disabled using the argument ssl => 0
66              
67             Detailed debugging can be turned on using the debu => 1 argument. It is off by default.
68              
69             my $palo = Firewall::PaloAlto->new(host => 'paloalto.local', username => 'admin', password => 'admin', ssl => 0, debug => 1);
70              
71             B<Parameters>
72              
73             =over
74              
75             =item *
76             host - the hostname or IP of the firewall to connect to.
77              
78             =item *
79             username - a username to connect to the firewall.
80              
81             =item *
82             password - a password to connect to the firewall.
83              
84             =item *
85             ssl (optional, default: 1) - use SSL to connect to the firewall.
86              
87             =item *
88             debug (optional, default: 0) - print debugging messages.
89              
90             =back
91              
92             =cut
93              
94              
95             has host => ( is => 'ro',
96             isa => 'Str',
97             required => '1',
98             );
99              
100             has username => ( is => 'ro',
101             isa => 'Str',
102             required => '1',
103             );
104              
105             has password => ( is => 'ro',
106             isa => 'Str',
107             required => '1',
108             );
109              
110             has api_key => ( is => 'rw', isa => 'Str', init_arg => undef, writer => '_api_key');
111              
112             has ssl => ( is => 'ro', isa => 'Bool', default => 1 );
113             has base_uri => ( is => 'ro',
114             isa => 'Str',
115             lazy => '1',
116             init_arg => undef,
117             default => sub { return 'http' . ($_[0]->ssl ? 's' : '') . '://' . $_[0]->host . '/api/?'; }
118              
119             );
120              
121             has 'debug' => ( is => 'ro', isa => 'Bool', required => 0, default => 0 );
122              
123             sub _create_requester {
124 0     0     my $self = shift;
125 0           my %args = @_;
126              
127 0           my $request = $self->base_uri. 'key=' . $self->api_key;
128              
129 0           for my $key (keys %args) {
130             #Add the argument on to the command line
131 0           $request .= "&$key=$args{$key}";
132             }
133              
134              
135             return sub {
136 0     0     my (%request_args) = @_;
137 0           my $user_agent = LWP::UserAgent->new;
138              
139 0           $self->_debug_print("API Request action", $args{action});
140              
141 0           for my $key (keys %request_args) {
142 0           $self->_debug_print("API Request String", "$key=$request_args{$key}");
143 0           $request .= "&$key=$request_args{$key}";
144             }
145              
146 0           my $http_request = HTTP::Request->new(GET => $request);
147 0           my $http_response = $user_agent->request($http_request);
148              
149 0           return $self->_check_response_and_parse($http_response);
150             }
151 0           }
152              
153             sub _check_response_and_parse {
154 0     0     my $self = shift;
155 0           my $http_response = shift;
156            
157             #We locally redefine croak so we can get some nice red printing around it.
158 2     2   29 no warnings 'redefine';
  2         7  
  2         8795  
159 0           local *original_croak = \&croak;
160 0     0     local *croak = sub { original_croak("\e[31m".$_[0]."\e[0m"); };
  0            
161            
162             #Check the http response message - croak if its not successful
163 0 0         croak "*[HTTP Request] Failed: ".$http_response->content if !$http_response->is_success;
164            
165 0           my $palo_response = XMLin($http_response->content, KeyAttr => 'name');
166            
167             #If the response doesn't contain a code (i.e. the keygen request doesn't), then we check the status string.
168             #If its successful, we assign our own 'custom code' as a workaround
169 0 0 0       if (!defined $palo_response->{code} && $palo_response->{status} eq "success") {
170 0           $palo_response->{code} = 1023;
171             }
172            
173             #Check the response from the Palo Alto:
174 0           my $code_info = $self->_get_response_info($palo_response->{code});
175 0           my $api_error = $code_info->{parse}->($palo_response);
176              
177 0 0 0       carp "*[API Request] $code_info->{string}: $api_error" and return 0 if $code_info->{is_error};
178            
179 0           $self->_debug_print("API Response", $palo_response->{status});
180            
181 0           return $palo_response;
182             }
183              
184             sub _get_response_info {
185 0     0     my ($self, $code) = @_;
186              
187             my $response_codes = {
188             400 => {is_error => 1, string => "Bad Request",
189 0     0     parse => sub { "Error 400" } },
190             403 => { is_error => 1, string => "Forbidden",
191 0     0     parse => sub { $_[0]->{result}->{msg}; }
192             },
193             1 => { is_error => 1, string => "Unknown Command",
194 0     0     parse => sub { "Error 1" } },
195             2 => { is_error => 1, string => "Internal Error (2)",
196 0     0     parse => sub { "Error 2" } },
197             3 => { is_error => 1, string => "Internal Error (3)",
198 0     0     parse => sub { "Error 3" } },
199             4 => { is_error => 1, string => "Internal Error (4)",
200 0     0     parse => sub { "Error 4" } },
201             5 => { is_error => 1, string => "Internal Error (4)",
202 0     0     parse => sub { "Error 5" } },
203             6 => { is_error => 1, string => "Bad XPath",
204 0     0     parse => sub { "Error 6" } },
205             7 => { is_error => 1, string => "Object not present",
206 0     0     parse => sub { "Error 7" } },
207             8 => { is_error => 1, string => "Object not unique",
208 0     0     parse => sub { "Error 8" } },
209             9 => { is_error => 1, string => "Internal Error (9)",
210 0     0     parse => sub { "Error 9" } },
211             10 => { is_error => 1, string => "Reference count not zero",
212 0     0     parse => sub { "Error 10" } },
213             11 => { is_error => 1, string => "Internal Error (11)",
214 0     0     parse => sub { "Error 11" } },
215             12 => { is_error => 1, string => "Invalid Object",
216 0 0   0     parse => sub { ref($_[0]->{msg}->{line}) eq 'ARRAY' ? join(" / ", @{ $_[0]->{msg}->{line} }) : $_[0]->{msg}->{line} }
  0            
217             },
218             13 => { is_error => 1, string => "Operation Failed",
219 0     0     parse => sub { $_[0]->{msg}->{line} } },
220             14 => { is_error => 1, string => "Operation Not Possible",
221 0     0     parse => sub { "Error 14" } },
222             15 => { is_error => 1, string => "Operation Denied",
223 0     0     parse => sub { "Error 15" } },
224             16 => { is_error => 1, string => "Unauthorized",
225 0     0     parse => sub { "Error 16" } },
226             17 => { is_error => 1, string => "Invalid Command",
227 0     0     parse => sub { "Error 16" } },
228             18 => { is_error => 1, string => "Malformed XML",
229 0     0     parse => sub { $_[0]->{msg}->{line} } },
230             19 => { is_error => 0, string => "Get Request Successful",
231       0     parse => sub{} },
232             20 => { is_error => 0, string => "Set Request Successful",
233       0     parse => sub{} },
234             21 => { is_error => 1, string => "Internal Error (21)",
235 0     0     parse => sub { "Error 21" } },
236             22 => { is_error => 1, string => "Session Timed Out",
237 0     0     parse => sub { "Error 22" } },
238             #Custom code for keygen success
239       0     1023 => { is_error => 0, string => "KeyGen Successful", parse => sub {} },
240 0           };
241              
242             #Return the hash, or 'undef' if the code doesn't exist.
243 0           return $response_codes->{$code};
244             }
245              
246             sub _generate_elements {
247 0     0     my $self = shift;
248 0           my %element_hash = @_;
249 0           my $element_string = "";
250              
251 0           for my $key (keys %element_hash) {
252 0           $element_string .= "<$key>";
253              
254             #If our hash points to an array reference, we iterate through the array and add member.
255             #This creates <key><member>a</member><member>b</member></key>
256 0 0         if (ref($element_hash{$key}) eq "ARRAY") {
    0          
257 0           for my $member (@{ $element_hash{$key} }) {
  0            
258 0           $element_string .= "<member>$member</member>";
259             }
260             }
261             #If we're pointing to another hash, we recurse down, as the structure will be the same.
262             #This allows us to do <key><another-key>data</another-key></key>
263             elsif (ref($element_hash{$key}) eq "HASH") {
264 0           $element_string .= $self->_generate_elements(%{ $element_hash{$key} });
  0            
265             }
266             #Otherwise its just a normal <key>value</key>
267             else {
268 0           $element_string .= "$element_hash{$key}";
269             }
270              
271 0           $element_string .= "</$key>";
272             }
273              
274 0           return $element_string;
275             }
276              
277             sub _debug_print {
278 0     0     my $self = shift;
279 0           my ($category, $debug_string, $colourise_sub) = @_;
280 0           my $string_colour = "\e[0;36m";
281 0           my $string_norm = "\e[0m";
282              
283 0 0         if (!$self->debug()) {
284 0           return 0;
285             }
286              
287             #We pass code in $colorise_sub - if it evaluates to true, we print the category in green
288             #If its false, we print in red. If its not defined, we print in orange.
289 0 0         if (defined $colourise_sub) {
290 0 0         $string_colour = $colourise_sub->() ? "\e[32m" : "\e[31m";
291             }
292              
293 0           say "*[".$string_colour.$category.$string_norm."] $debug_string";
294             }
295              
296             =head1 OBJECT METHODS
297              
298             =head2 connect()
299              
300             The connect functions connects to the Palo Alto, validates and saves the API key.
301             It has no parameters
302              
303             $pa->connect();
304              
305             =cut
306              
307             sub connect {
308 0     0 1   my $self = shift;
309              
310 0           my $user_agent = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
311 0           my $key_request = HTTP::Request->new(GET => $self->base_uri.'type=keygen&user='.$self->username.'&password='.$self->password);
312              
313 0           $self->_debug_print("Key Request", "");
314              
315 0           my $key_response = $user_agent->request($key_request);
316              
317 0           my $pa_response = $self->_check_response_and_parse($key_response);
318              
319 0 0         if ($pa_response->{status} eq 'success') {
320 0           $self->_api_key($pa_response->{result}->{key});
321 0           return 1;
322             }
323             else {
324 0           return 0;
325             }
326             }
327              
328              
329             =head2 commit(%parameters)
330              
331             The commit function commits the current candidate configuration to the Palo Alto firewall.
332              
333             $pa_firewall->commit(vsys_id => 10, poll => 10);
334              
335             B<Parameters>
336              
337             =over
338              
339             =item *
340             vsys_id (optional) - if supplied, performs a partial commit on the vsys specified. If not provided, performs a full commit on the device.
341              
342             =item *
343             poll (optional, default: 5 seconds) - defines the interval (seconds) that the method will poll the device to get the current status of the commit job.
344              
345             =back
346              
347             =cut
348              
349             sub commit {
350 0     0 1   my $self = shift;
351 0           my %args = @_;
352 0           my $requester = $self->_create_requester(type => 'commit');
353 0           my $operate = $self->_create_requester(type => 'op');
354 0           my $cmd = "<commit></commit>";
355              
356             #If a poll interval is not defined, we default to 5 seconds.
357 0   0       $args{poll} //= 5;
358              
359 0 0         if (defined $args{vsys_id}) {
360 0           $cmd = "<commit><partial><vsys><member>vsys$args{vsys_id}</member></vsys></partial></commit>";
361             }
362              
363 0           my $response = $requester->(cmd => $cmd);
364              
365 0           my $job_result;
366              
367             do {
368 0           $job_result = $operate->(cmd => "<show><jobs><id>$response->{result}->{job}</id></jobs></show>");
369             $self->_debug_print((caller(0))[3], "JobID: $response->{result}->{job}, Status: $job_result->{result}->{job}->{result}, Progress: $job_result->{result}->{job}->{progress}",
370 0     0     sub { $job_result->{result}->{job}->{result} ne "FAILED" });
  0            
371              
372 0           sleep($args{poll});
373 0           } while ($job_result->{result}->{job}->{result} eq 'PEND');
374             }
375              
376              
377             =head2 vsys($action, %parameters)
378              
379             The vsys function creates a new virtual system.
380              
381             $pa->vsys('set', vsys_id => 4, display-name => "Tenant 4");
382              
383             B<Parameters>
384              
385             =over
386              
387             =item * $action - perform an action: ['get' | 'set' | 'delete']
388              
389             =item * vsys_id - the ID of the virtual system to perform the action on.
390              
391             =item * display-name - sets the display name of the virtual system.
392              
393             =back
394              
395             =cut
396              
397             sub vsys {
398 0     0 1   my $self = shift;
399 0           my $action = shift;
400 0           my (%args) = @_;
401              
402             #Validate our parameters.
403 0           validate(
404             @_, {
405             vsys_id => 1,
406             "display-name" => 1
407             }
408             );
409              
410 0           my $vsys_id = delete $args{vsys_id};
411 0           my $requester = $self->_create_requester(type => 'config', action => $action);
412              
413 0           my $elements = $self->_generate_elements(%args);
414              
415 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/vsys/entry[\@name='vsys$vsys_id']", element => $elements);
416             }
417              
418             =head2 vsys_import($action, %parameters);
419              
420             The vsys_import function imports interfaces and virtual-routers into a virtual system.
421              
422             $pa_firewall->vsys_import('set', vsys_id => 4, interface => [ ethernet1/1, ethernet1/2 ], virtual-router => [ default ]);
423              
424             B<Parameters>
425              
426             =over
427              
428             =item * $action - perform an action: ['get' | 'set' | 'delete']
429              
430             =item * vsys_id - the ID of the virtual system to perform the action on.
431              
432             =item * interface - an anonymous array of one or more interfaces to add to the virtual system.
433              
434             =item * virtual-router - an anonymous array of one or more virtual routers to add to the virtual system.
435              
436             =back
437              
438             =cut
439              
440             sub vsys_import {
441 0     0 1   my $self = shift;
442 0           my $action = shift;
443 0           my (%args) = @_;
444              
445             #validate(
446             # @_, {
447             # vsys_id => 1,
448             # interface => 0;
449             # "virtual-router" => 0,
450             # }
451             #);
452              
453 0           my $vsys_id = delete @args{vsys_id};
454              
455 0           my $requester = $self->_create_requester(type => 'config', action => $action);
456 0           my $elements = $self->_generate_elements(%args);
457              
458             #Add the interface or virtual router to a vsys
459 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/vsys/entry[\@name='vsys$vsys_id']/import/network", element => $elements);
460             }
461              
462             =head2 l3_subinterface($action, %parameters)
463              
464             This function creates a new layer 3 subinterface underneath a parent interface.
465              
466             $pa->l3_subinterface('set', parent => 'ethernet1/1', tag => 5, description => 'Tenant x untrust interface');
467              
468             B<Parameters>
469              
470             =over
471              
472              
473             =item * $action - perform an action: ['get' | 'set' | 'delete']
474              
475             =item * parent - the parent interface of the new subinterface
476              
477             =item * tag - the VLAN tag to use on the sub-interface. This is also used as the logical sub-interface identifier.
478              
479             =item * description - a description to add to the sub-interface.
480              
481             =back
482              
483             =cut
484              
485             sub l3_subinterface {
486 0     0 1   my $self = shift;
487 0           my ($action, %args) = @_;
488              
489 0           my $parent_interface = delete @args{'parent'};
490              
491 0           my $requester = $self->_create_requester(type => 'config', action => $action);
492 0           my $elements = $self->_generate_elements(%args);
493              
494             #Create the sub-interface
495 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/network/interface/aggregate-ethernet/entry[\@name='$parent_interface']/layer3/units/entry[\@name='$parent_interface.$args{tag}']",
496             element => $elements);
497              
498             }
499              
500              
501             =head2 virtual_router($action, %parameters)
502              
503             B<Parameters>
504              
505             =over
506              
507              
508             =item * $action - perform an action: ['get' | 'set' | 'delete']
509              
510             =item * vr_name - the name of the virtual router to perform the action on.
511              
512             =item * interface - an anonymous array of one or more interfaces to add to the virtual router.
513              
514             =back
515              
516             =cut
517              
518             sub virtual_router {
519 0     0 1   my $self = shift;
520 0           my ($action, %args) = @_;
521              
522 0           my $vr_name = delete @args{'vr_name'};
523              
524 0           my $requester = $self->_create_requester(type => 'config', action => $action);
525 0           my $elements = $self->_generate_elements(%args);
526            
527             #Create the virtual router
528 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/network/virtual-router/entry[\@name='$vr_name']",
529             element => $elements);
530             }
531              
532             =head2 zone($action, %parameters)
533              
534             B<Parameters>
535              
536             =over
537              
538             =item * $action - perform an action: ['get' | 'set' | 'delete']
539              
540             =item * vsys_id - the virtual system ID to which the zone is/should be a member of.
541              
542             =item * zone - the name of the zone to create/update/delete.
543              
544             =item * layer3 - an anonymous array of one or more interfaces to add to the zone.
545              
546             =back
547              
548             =cut
549              
550             sub zone {
551 0     0 1   my $self = shift;
552 0           my ($action, %args) = @_;
553 0           my $requester = $self->_create_requester(type => 'config', action => $action);
554              
555 0           my ($vsys_id, $zone) = delete @args{'vsys_id', 'zone'};
556 0   0       $vsys_id //= 1;
557              
558 0           my $elements = $self->_generate_elements(%args);
559              
560 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/vsys/entry[\@name='vsys$vsys_id']/zone/entry[\@name='$zone']/network",
561             element => $elements);
562             }
563              
564             =head2 ipv4_static_route($action, %parameters)
565              
566             B<Parameters>
567              
568             =over
569              
570             =item * $action - perform an action: ['get' | 'set' | 'delete']
571              
572             =item * vr_name - the name of the virtual router in which the static route resides.
573              
574             =item * route_name - the name of the route to perform the action on.
575              
576             =item * destination - the IPv4 destination of the route (IP/prefix)
577              
578             =item * nexthop - an anonymous hash specifying the next hop
579              
580             =item * ip-address - the next hop IP address
581              
582             =item * interface - the next hop interface
583              
584             =back
585              
586             =cut
587              
588             sub ipv4_static_route {
589 0     0 1   my $self = shift;
590 0           my ($action, %args) = @_;
591 0           my $requester = $self->_create_requester(type => 'config', action => $action);
592              
593 0           my ($vr_name, $route_name) = delete @args{'vr_name', 'route_name'};
594 0 0         $route_name = defined $route_name ? "\@name='$route_name'" : "'*'";
595              
596 0           my $elements = $self->_generate_elements(%args);
597              
598 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/network/virtual-router/entry[\@name='$vr_name']/routing-table/ip/static-route/entry[$route_name]",
599             element => $elements);
600             }
601              
602              
603             =head2 ipv6_static_route($action, %parameters)
604              
605             B<Parameters>
606              
607             =over
608              
609              
610             =item * $action - perform an action: ['get' | 'set' | 'delete']
611              
612             =item * vr_name - the name of the virtual router in which the static route resides.
613              
614             =item * route_name - the name of the route to perform the action on.
615              
616             =item * destination - the IPv6 destination of the route (IP/prefix)
617              
618             =item * nexthop - an anonymous hash specifying the next hop
619              
620             =item * ipv6-address - the next hop IPv6 address
621              
622             =item * interface - the next hop interface
623              
624             =back
625              
626             =cut
627              
628             sub ipv6_static_route {
629 0     0 1   my $self = shift;
630 0           my ($action, %args) = @_;
631 0           my $requester = $self->_create_requester(type => 'config', action => $action);
632              
633 0           my ($vr_name, $route_name) = delete @args{'vr_name', 'route_name'};
634 0 0         $route_name = defined $route_name ? "\@name='$route_name'" : "'*'";
635              
636 0           my $elements = $self->_generate_elements(%args);
637              
638 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/network/virtual-router/entry[\@name='$vr_name']/routing-table/ipv6/static-route/entry[$route_name]",
639             element => $elements);
640             }
641              
642             =head2 address($action, %parameters)
643              
644             B<Parameters>
645              
646             =over
647              
648             =item * vsys_id - the vsys ID in which the resides/shall reside.
649              
650             =item * name - the name of the address.
651              
652             =item * ip-netmask - the IP/netmask combination which defines the address.
653              
654             =item * ip-range - an IP address range (format: 'IPstart-IPend')
655              
656             =back
657              
658             =cut
659              
660             sub address {
661 0     0 1   my $self = shift;
662 0           my ($action, %args) = @_;
663 0           my $requester = $self->_create_requester(type => 'config', action => $action);
664              
665             #Keys to be extracted and deleted because they aren't part of the element
666             #delete returns the values that were deleted.
667 0           my ($vsys, $address) = delete @args{'vsys_id', 'name'};
668              
669             #If the vsys if not defined, we default to vsys1
670 0   0       $vsys //= "vsys1";
671              
672 0 0         $address = defined $address ? "\@name='$address'" : "'*'";
673              
674 0           my $elements = $self->_generate_elements(%args);
675              
676 0           return $requester->(xpath => "/config/devices/entry[\@name='localhost.localdomain']/vsys/entry[\@name=\'$vsys\']/address/entry[$address]", element => $elements);
677             }
678              
679              
680             =head2 address_group($action, %parameters)
681              
682             B<Parameters>
683              
684             =over
685              
686              
687             =item * $action - perform an action: ['get' | 'set' | 'delete']
688              
689             =item * vsys_id - the vsys ID in which the address group resides/shall reside.A
690              
691             =item * name - the name of the address group.
692              
693             =item * member - an anonymous array of one or more addresses. These can be either address entries created with address(), or explicit IP/netmasks (e.g. 9.8.8.8/32)
694              
695             =back
696              
697             =cut
698              
699             sub address_group {
700 0     0 1   my $self = shift;
701 0           my ($action, %args) = @_;
702 0           my $requester = $self->_create_requester(type => 'config', action => $action);
703              
704             #Keys to be extracted and deleted because they aren't part of the element
705             #delete returns the values that were deleted.
706 0           my ($vsys, $name) = delete @args{'vsys_id', 'name'};
707              
708             #If the vsys if not defined, we default to vsys1
709 0   0       $vsys //= "vsys1";
710              
711 0 0         $name = defined $name ? "\@name='$name'" : "'*'";
712              
713 0           my $elements = $self->_generate_elements(%args);
714              
715 0           return $requester->(xpath => "/config/devices/entry/vsys/entry[\@name=\'$vsys\']/address-group/entry[$name]", element => $elements);
716             }
717              
718              
719              
720             =head2 security_rule($action, %parameters)
721              
722             B<Parameters>
723              
724             =over
725              
726              
727             =item * $action - perform an action: ['get' | 'set' | 'delete']
728              
729             =item * vsys_id - the virtual system ID of the vsys in which the security rule resides/will reside. Defaults to 1 if not supplied.
730              
731             =item * name - the name of the rule.
732              
733             =item * from - the source zone, defaults to 'any' if not supplied.
734              
735             =item * to - the destination zone, defaults to 'any' if not supplied.
736              
737             =item * source - an anonymous array of source addresses - can be addresses, address groups or explicit IP/netmask entries. Defaults to 'any' if not supplied.
738              
739             =item * destination - an anonymous array of destination addresses - can be addresses, address groups or explicit IP/netmask entries. Defaults to 'any' if not supplied.
740              
741             =item * service - an anonymous array of one or more services. Defaults to 'application-default' if not supplied.
742              
743             =item * appplication - an anonymous array of one or more Palo Alto applications. Defaults to 'any' if not supplied.
744              
745             =item * source-user - an anonymous array of one or more Palo Alto source user mappings. Defaults to 'any' if not supplied.
746              
747             =item * hip-profile - an anonymous array of Host Information Profiles. defaults to 'any' if not supplied.
748              
749             =item * action - an action for the rule, either 'allow', 'deny' or 'drop'. Defaults to 'allow' if not supplied.
750              
751             =back
752              
753             =cut
754              
755              
756             sub security_rule {
757 0     0 1   my $self = shift;
758 0           my ($action, %args) = @_;
759 0           my $requester = $self->_create_requester(type => 'config', action => $action);
760              
761             #If the name isn't defined, default to all rules
762 0 0         my $rule_name = defined $args{name} ? "\@name='$args{name}'" : "'*'";
763 0           delete $args{name};
764            
765             #If the vsys if not defined, we default to vsys1
766 0   0       my $vsys = $args{vsys_id} // "vsys1";
767 0           delete $args{vsys_id};
768              
769             #If any of the following items aren't defined, we default to an anon array of type 'any'
770 0           my @default_any = qw(to from source destination application source-user hip-profiles);
771 0           for my $key (@default_any) {
772 0   0       $args{$key} //= ['any'];
773             }
774              
775             #If the service isn't defined, we default to 'application-default'
776 0   0       $args{service} //= ['application-default'];
777              
778             #If the action isn't defined, we defailt to 'allow'
779 0   0       $args{action} //= 'allow';
780              
781 0           my $elements = $self->_generate_elements(%args);
782              
783 0           return $requester->(xpath => "/config/devices/entry/vsys/entry[\@name=\'$vsys\']/rulebase/security/rules/entry[$rule_name]", element => $elements);
784             }
785              
786             =head1 AUTHOR
787              
788             Greg Foletta, C<< <greg at foletta.org> >>
789              
790             =head1 BUGS
791              
792             Please report any bugs or feature requests to C<bug-firewall-paloalto at rt.cpan.org>, or through
793             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Firewall-PaloAlto>. I will be notified, and then you'll
794             automatically be notified of progress on your bug as I make changes.
795              
796              
797              
798             =head1 SUPPORT
799              
800             You can find documentation for this module with the perldoc command.
801              
802             perldoc Firewall::PaloAlto
803              
804              
805             You can also look for information at:
806              
807             =over 4
808              
809             =item * RT: CPAN's request tracker (report bugs here)
810              
811             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Firewall-PaloAlto>
812              
813             =item * AnnoCPAN: Annotated CPAN documentation
814              
815             L<http://annocpan.org/dist/Firewall-PaloAlto>
816              
817             =item * CPAN Ratings
818              
819             L<http://cpanratings.perl.org/d/Firewall-PaloAlto>
820              
821             =item * Search CPAN
822              
823             L<http://search.cpan.org/dist/Firewall-PaloAlto/>
824              
825             =back
826              
827              
828             =head1 ACKNOWLEDGEMENTS
829              
830              
831             =head1 LICENSE AND COPYRIGHT
832              
833             Copyright 2015 Greg Foletta.
834              
835             This program is free software; you can redistribute it and/or modify it
836             under the terms of the the Artistic License (2.0). You may obtain a
837             copy of the full license at:
838              
839             L<http://www.perlfoundation.org/artistic_license_2_0>
840              
841             Any use, modification, and distribution of the Standard or Modified
842             Versions is governed by this Artistic License. By using, modifying or
843             distributing the Package, you accept this license. Do not use, modify,
844             or distribute the Package, if you do not accept this license.
845              
846             If your Modified Version has been derived from a Modified Version made
847             by someone other than you, you are nevertheless required to ensure that
848             your Modified Version complies with the requirements of this license.
849              
850             This license does not grant you the right to use any trademark, service
851             mark, tradename, or logo of the Copyright Holder.
852              
853             This license includes the non-exclusive, worldwide, free-of-charge
854             patent license to make, have made, use, offer to sell, sell, import and
855             otherwise transfer the Package with respect to any patent claims
856             licensable by the Copyright Holder that are necessarily infringed by the
857             Package. If you institute patent litigation (including a cross-claim or
858             counterclaim) against any party alleging that the Package constitutes
859             direct or contributory patent infringement, then this Artistic License
860             to you shall terminate on the date that such litigation is filed.
861              
862             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
863             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
864             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
865             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
866             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
867             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
868             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
869             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
870              
871              
872             =cut
873              
874             1; # End of Firewall::PaloAlto