File Coverage

blib/lib/Net/Silverpeak/Orchestrator.pm
Criterion Covered Total %
statement 23 322 7.1
branch 0 90 0.0
condition 0 18 0.0
subroutine 8 49 16.3
pod 37 38 97.3
total 68 517 13.1


line stmt bran cond sub pod time code
1             package Net::Silverpeak::Orchestrator;
2             $Net::Silverpeak::Orchestrator::VERSION = '0.008000';
3             # ABSTRACT: Silverpeak Orchestrator REST API client library
4              
5 2     2   480107 use 5.024;
  2         17  
6 2     2   1106 use Moo;
  2         14680  
  2         10  
7 2     2   3080 use feature 'signatures';
  2         5  
  2         316  
8 2     2   1301 use Types::Standard qw( Bool Str );
  2         245373  
  2         22  
9 2     2   5301 use Carp qw( croak );
  2         5  
  2         136  
10 2     2   1166 use HTTP::CookieJar;
  2         65927  
  2         103  
11 2     2   16 use List::Util qw( any );
  2         4  
  2         158  
12             # use Data::Dumper::Concise;
13              
14 2     2   23 no warnings "experimental::signatures";
  2         4  
  2         5963  
15              
16              
17             has 'user' => (
18             isa => Str,
19             is => 'rw',
20             predicate => 1,
21             );
22             has 'passwd' => (
23             isa => Str,
24             is => 'rw',
25             predicate => 1,
26             );
27             has 'api_key' => (
28             isa => Str,
29             is => 'rw',
30             predicate => 1,
31             );
32              
33              
34             has 'is_logged_in' => (
35             isa => Bool,
36             is => 'rwp',
37             default => sub { 0 },
38             );
39              
40             with 'Role::REST::Client';
41              
42             has '+persistent_headers' => (
43             default => sub {
44             my $self = shift;
45             my %headers;
46             $headers{'X-Auth-Token'} = $self->api_key
47             if $self->has_api_key;
48             return \%headers;
49             },
50             );
51              
52             around 'do_request' => sub($orig, $self, $method, $uri, $opts) {
53             # $uri .= '?apiKey=' . $self->api_key
54             # if $self->has_api_key;
55             # warn 'request: ' . Dumper([$method, $uri, $opts]);
56             my $response = $orig->($self, $method, $uri, $opts);
57             # warn 'response: ' . Dumper($response);
58             return $response;
59             };
60              
61 0     0     sub _build_user_agent ($self) {
  0            
  0            
62 0           require HTTP::Thin;
63              
64 0           my %params = $self->clientattrs->%*;
65 0 0 0       if ($self->has_user && $self->has_passwd) {
66 0           $params{cookie_jar} = HTTP::CookieJar->new;
67             }
68              
69 0           return HTTP::Thin->new(%params);
70             }
71              
72 0     0     sub _error_handler ($self, $res) {
  0            
  0            
  0            
73             my $error_message = ref $res->data eq 'HASH' && exists $res->data->{error}
74             ? $res->data->{error}
75 0 0 0       : $res->response->decoded_content;
76              
77 0           croak('error (' . $res->code . '): ' . $error_message);
78             }
79              
80              
81 0     0 1   sub login($self) {
  0            
  0            
82 0 0 0       die "user and password required\n"
83             unless $self->has_user && $self->has_passwd;
84              
85 0           my $res = $self->post('/gms/rest/authentication/login', {
86             user => $self->user,
87             password => $self->passwd,
88             });
89              
90 0 0         $self->_error_handler($res)
91             unless $res->code == 200;
92              
93 0           my @cookies = $self->user_agent->cookie_jar->cookies_for($self->server);
94 0 0         if (my ($csrf_cookie) = grep { $_->{name} eq 'orchCsrfToken' } @cookies ) {
  0            
95 0           $self->set_persistent_header('X-XSRF-TOKEN' => $csrf_cookie->{value});
96             }
97              
98 0           $self->_set_is_logged_in(1);
99              
100 0           return 1;
101             }
102              
103              
104 0     0 1   sub logout($self) {
  0            
  0            
105 0 0 0       die "user and password required\n"
106             unless $self->has_user && $self->has_passwd;
107              
108 0           my $res = $self->get('/gms/rest/authentication/logout');
109 0 0         $self->_error_handler($res)
110             unless $res->code == 200;
111              
112 0           delete $self->persistent_headers->{'X-XSRF-TOKEN'};
113              
114 0           $self->_set_is_logged_in(0);
115              
116 0           return 1;
117             }
118              
119              
120 0     0 1   sub get_version($self) {
  0            
  0            
121 0           my $res = $self->get('/gms/rest/gms/versions');
122 0 0         $self->_error_handler($res)
123             unless $res->code == 200;
124              
125 0           return $res->data->{current};
126             }
127              
128              
129 0     0 1   sub list_templategroups($self) {
  0            
  0            
130 0           my $res = $self->get('/gms/rest/template/templateGroups');
131 0 0         $self->_error_handler($res)
132             unless $res->code == 200;
133 0           return $res->data;
134             }
135              
136              
137 0     0 1   sub get_templategroup($self, $name) {
  0            
  0            
  0            
138 0           my $res = $self->get('/gms/rest/template/templateGroups/' . $name);
139 0 0         $self->_error_handler($res)
140             unless $res->code == 200;
141 0           return $res->data;
142             }
143              
144              
145 0     0 1   sub create_templategroup($self, $name, $data = {}) {
  0            
  0            
  0            
  0            
146 0           $data->{name} = $name;
147 0           my $res = $self->post('/gms/rest/template/templateCreate',
148             $data);
149 0 0         $self->_error_handler($res)
150             unless $res->code == 204;
151 0           return 1;
152             }
153              
154              
155 0     0 1   sub update_templates_of_templategroup($self, $name, $templatenames) {
  0            
  0            
  0            
  0            
156 0 0         croak('templates names must be passed as an arrayref')
157             unless ref $templatenames eq 'ARRAY';
158              
159 0           my $res = $self->post('/gms/rest/template/templateSelection/' . $name,
160             $templatenames);
161 0 0         $self->_error_handler($res)
162             unless $res->code == 200;
163 0           return $res->data;
164             }
165              
166              
167 0     0 1   sub update_templategroup($self, $name, $data) {
  0            
  0            
  0            
  0            
168 0           my $res = $self->post('/gms/rest/template/templateGroups/' . $name,
169             $data);
170 0 0         $self->_error_handler($res)
171             unless $res->code == 200;
172 0           return $res->data;
173             }
174              
175              
176 0     0 1   sub delete_templategroup($self, $name) {
  0            
  0            
  0            
177 0           my $res = $self->delete('/gms/rest/template/templateGroups/' . $name);
178 0 0         $self->_error_handler($res)
179             unless $res->code == 204;
180 0           return 1;
181             }
182              
183              
184 0     0 1   sub get_vrf_by_id ($self) {
  0            
  0            
185 0           my $res = $self->get("/gms/rest/vrf/config/segments");
186 0 0         $self->_error_handler($res)
187             unless $res->code == 200;
188 0           return $res->data;
189             }
190              
191              
192 0     0 1   sub list_appliances($self) {
  0            
  0            
193 0           my $res = $self->get('/gms/rest/appliance');
194 0 0         $self->_error_handler($res)
195             unless $res->code == 200;
196 0           return $res->data;
197             }
198              
199              
200 0     0 1   sub get_appliance($self, $id) {
  0            
  0            
  0            
201 0           my $res = $self->get('/gms/rest/appliance/' . $id);
202 0 0         $self->_error_handler($res)
203             unless $res->code == 200;
204 0           return $res->data;
205             }
206              
207              
208 0     0 1   sub get_appliance_extrainfo ($self, $id) {
  0            
  0            
  0            
209 0           my $res = $self->get("/gms/rest/appliance/extraInfo/$id");
210 0 0         $self->_error_handler($res)
211             unless $res->code == 200;
212 0           return $res->data;
213             }
214              
215              
216 0     0 1   sub get_ha_groups_by_id ($self) {
  0            
  0            
217 0           my $res = $self->get("/gms/rest/haGroups");
218 0 0         $self->_error_handler($res)
219             unless $res->code == 200;
220 0           return $res->data;
221             }
222              
223              
224 0     0 1   sub get_deployment ($self, $id) {
  0            
  0            
  0            
225 0           my $res = $self->get("/gms/rest/deployment/$id");
226 0 0         $self->_error_handler($res)
227             unless $res->code == 200;
228 0           return $res->data;
229             }
230              
231              
232 0     0 1   sub get_interface_state ($self, $id) {
  0            
  0            
  0            
233 0           my $res = $self->get("/gms/rest/interfaceState/$id");
234 0 0         $self->_error_handler($res)
235             unless $res->code == 200;
236 0           return $res->data;
237             }
238              
239              
240 0     0 1   sub get_interface_labels_by_type ($self) {
  0            
  0            
241 0           my $res = $self->get("/gms/rest/gms/interfaceLabels");
242 0 0         $self->_error_handler($res)
243             unless $res->code == 200;
244 0           return $res->data;
245             }
246              
247              
248 0     0 1   sub list_template_applianceassociations($self) {
  0            
  0            
249 0           my $res = $self->get('/gms/rest/template/applianceAssociation');
250 0 0         $self->_error_handler($res)
251             unless $res->code == 200;
252 0           return $res->data;
253             }
254              
255              
256 0     0 1   sub list_applianceids_by_templategroupname($self, $name) {
  0            
  0            
  0            
257 0           my $associations = $self->list_template_applianceassociations;
258 0           my @appliance_ids;
259 0           for my $appliance_id (keys %$associations) {
260             push @appliance_ids, $appliance_id
261 0 0   0     if any { $_ eq $name } $associations->{$appliance_id}->@*;
  0            
262             }
263 0           return \@appliance_ids;
264             }
265              
266              
267 0     0 1   sub list_addressgroups($self) {
  0            
  0            
268 0           my $res = $self->get('/gms/rest/ipObjects/addressGroup');
269 0 0         $self->_error_handler($res)
270             unless $res->code == 200;
271 0           return $res->data;
272             }
273              
274              
275 0     0 1   sub list_addressgroup_names($self) {
  0            
  0            
276 0           my $res = $self->get('/gms/rest/ipObjects/addressGroupNames');
277 0 0         $self->_error_handler($res)
278             unless $res->code == 200;
279 0           return $res->data;
280             }
281              
282              
283 0     0 1   sub get_addressgroup($self, $name) {
  0            
  0            
  0            
284 0           my $res = $self->get('/gms/rest/ipObjects/addressGroup/' . $name);
285 0 0         $self->_error_handler($res)
286             unless $res->code == 200;
287 0           return $res->data;
288             }
289              
290              
291 0     0 1   sub create_or_update_addressgroup($self, $name, $data) {
  0            
  0            
  0            
  0            
292 0           $data->{name} = $name;
293 0           $data->{type} = 'AG';
294 0           my $res = $self->post('/gms/rest/ipObjects/addressGroup', $data);
295 0 0         $self->_error_handler($res)
296             unless $res->code == 204;
297 0           return 1;
298             }
299              
300              
301 0     0 1   sub update_addressgroup($self, $name, $data) {
  0            
  0            
  0            
  0            
302 0           $data->{name} = $name;
303 0           $data->{type} = 'AG';
304 0           my $res = $self->put('/gms/rest/ipObjects/addressGroup', $data);
305 0 0         $self->_error_handler($res)
306             unless $res->code == 204;
307 0           return 1;
308             }
309              
310              
311 0     0 1   sub delete_addressgroup($self, $name) {
  0            
  0            
  0            
312 0           my $res = $self->delete('/gms/rest/ipObjects/addressGroup/' . $name);
313 0 0         $self->_error_handler($res)
314             unless $res->code == 204;
315 0           return 1;
316             }
317              
318              
319 0     0 1   sub list_servicegroups($self) {
  0            
  0            
320 0           my $res = $self->get('/gms/rest/ipObjects/serviceGroup');
321 0 0         $self->_error_handler($res)
322             unless $res->code == 200;
323 0           return $res->data;
324             }
325              
326              
327 0     0 1   sub list_servicegroup_names($self) {
  0            
  0            
328 0           my $res = $self->get('/gms/rest/ipObjects/serviceGroupNames');
329 0 0         $self->_error_handler($res)
330             unless $res->code == 200;
331 0           return $res->data;
332             }
333              
334              
335 0     0 1   sub get_servicegroup($self, $name) {
  0            
  0            
  0            
336 0           my $res = $self->get('/gms/rest/ipObjects/serviceGroup/' . $name);
337 0 0         $self->_error_handler($res)
338             unless $res->code == 200;
339 0           return $res->data;
340             }
341              
342              
343 0     0 1   sub create_or_update_servicegroup($self, $name, $data) {
  0            
  0            
  0            
  0            
344 0           $data->{name} = $name;
345 0           $data->{type} = 'SG';
346 0           my $res = $self->post('/gms/rest/ipObjects/serviceGroup', $data);
347 0 0         $self->_error_handler($res)
348             unless $res->code == 204;
349 0           return 1;
350             }
351              
352              
353 0     0 1   sub update_servicegroup($self, $name, $data) {
  0            
  0            
  0            
  0            
354 0           $data->{name} = $name;
355 0           $data->{type} = 'SG';
356 0           my $res = $self->put('/gms/rest/ipObjects/serviceGroup', $data);
357 0 0         $self->_error_handler($res)
358             unless $res->code == 204;
359 0           return 1;
360             }
361              
362              
363 0     0 1   sub delete_servicegroup($self, $name) {
  0            
  0            
  0            
364 0           my $res = $self->delete('/gms/rest/ipObjects/serviceGroup/' . $name);
365 0 0         $self->_error_handler($res)
366             unless $res->code == 204;
367 0           return 1;
368             }
369              
370              
371 0     0 1   sub list_domain_applications($self, $resource_key='userDefined') {
  0            
  0            
  0            
372 0           my $res = $self->get('/gms/rest/applicationDefinition/dnsClassification',
373             { resourceKey => $resource_key });
374 0 0         $self->_error_handler($res)
375             unless $res->code == 200;
376 0           return $res->data;
377             }
378              
379              
380 0     0 1   sub create_or_update_domain_application($self, $domain, $data) {
  0            
  0            
  0            
  0            
381 0           $data->{domain} = $domain;
382 0           my $res = $self->post('/gms/rest/applicationDefinition/dnsClassification2/domain', $data);
383 0 0         $self->_error_handler($res)
384             unless $res->code == 200;
385 0           return 1;
386             }
387              
388              
389 0     0 1   sub delete_domain_application($self, $domain) {
  0            
  0            
  0            
390 0           my $res = $self->delete('/gms/rest/applicationDefinition/dnsClassification/' . $domain);
391 0 0         $self->_error_handler($res)
392             unless $res->code == 200;
393 0           return 1;
394             }
395              
396              
397 0     0 1   sub list_application_groups($self, $resource_key='userDefined') {
  0            
  0            
  0            
398 0           my $res = $self->get('/gms/rest/applicationDefinition/applicationTags',
399             { resourceKey => $resource_key });
400 0 0         $self->_error_handler($res)
401             unless $res->code == 200;
402 0           return $res->data;
403             }
404              
405              
406 0     0 1   sub create_or_update_application_group($self, $name, $data) {
  0            
  0            
  0            
  0            
407 0           my $application_groups = $self->list_application_groups;
408             # set or overwrite existing application group
409 0           $application_groups->{$name} = $data;
410 0           my $res = $self->post('/gms/rest/applicationDefinition/applicationTags',
411             $application_groups);
412 0 0         $self->_error_handler($res)
413             unless $res->code == 200;
414 0           return 1;
415             }
416              
417              
418 0     0 1   sub delete_application_group($self, $name) {
  0            
  0            
  0            
419 0           my $application_groups = $self->list_application_groups;
420             # set or overwrite existing application group
421             croak("application '$name' doesn't exist")
422 0 0         unless exists $application_groups->{$name};
423 0           delete $application_groups->{$name};
424 0           my $res = $self->post('/gms/rest/applicationDefinition/applicationTags',
425             $application_groups);
426 0 0         $self->_error_handler($res)
427             unless $res->code == 200;
428 0           return 1;
429             }
430              
431              
432             sub DEMOLISH {
433 0     0 0   my $self = shift;
434              
435 0 0 0       $self->logout
      0        
436             if $self->has_user
437             && $self->has_passwd
438             && $self->is_logged_in;
439             }
440              
441             1;
442              
443             __END__
444              
445             =pod
446              
447             =encoding UTF-8
448              
449             =head1 NAME
450              
451             Net::Silverpeak::Orchestrator - Silverpeak Orchestrator REST API client library
452              
453             =head1 VERSION
454              
455             version 0.008000
456              
457             =head1 SYNOPSIS
458              
459             use strict;
460             use warnings;
461             use Net::Silverpeak::Orchestrator;
462              
463             my $orchestrator = Net::Silverpeak::Orchestrator->new(
464             server => 'https://orchestrator.example.com',
465             user => 'username',
466             passwd => '$password',
467             clientattrs => { timeout => 30 },
468             );
469              
470             $orchestrator->login;
471              
472             # OR
473              
474             $orchestrator = Net::Silverpeak::Orchestrator->new(
475             server => 'https://orchestrator.example.com',
476             api_key => '$api-key',
477             clientattrs => { timeout => 30 },
478             );
479              
480             =head1 DESCRIPTION
481              
482             This module is a client library for the Silverpeak Orchestrator REST API.
483             Currently it is developed and tested against version 9.0.2.
484              
485             =head1 ATTRIBUTES
486              
487             =head2 is_logged_in
488              
489             Returns true if successfully logged in.
490              
491             =head1 METHODS
492              
493             =head2 login
494              
495             Logs into the Silverpeak Orchestrator.
496             Only required when using username and password, not for api key.
497              
498             =head2 logout
499              
500             Logs out of the Silverpeak Orchestrator.
501             Only possible when using username and password, not for api key.
502              
503             =head2 get_version
504              
505             Returns the Silverpeak Orchestrator version.
506              
507             =head2 list_templategroups
508              
509             Returns an arrayref of template groups.
510              
511             =head2 get_templategroup
512              
513             Returns a template group by name.
514              
515             =head2 create_templategroup
516              
517             Takes a template group name and a hashref with its config.
518              
519             Returns true on success.
520              
521             Throws an exception on error.
522              
523             =head2 update_templates_of_templategroup
524              
525             Takes a template group name and an arrayref of template names.
526              
527             Returns true on success.
528              
529             Throws an exception on error.
530              
531             =head2 update_templategroup
532              
533             Takes a template group name and a hashref of template configs.
534              
535             Returns true on success.
536              
537             Throws an exception on error.
538              
539             =head2 delete_templategroup
540              
541             Takes a template group name.
542              
543             Returns true on success.
544              
545             Throws an exception on error.
546              
547             =head2 get_vrf_by_id
548              
549             Returns a hashref of VRFs indexed by their id.
550              
551             =head2 list_appliances
552              
553             Returns an arrayref of appliances.
554              
555             =head2 get_appliance
556              
557             Returns an appliance by id.
558              
559             =head2 get_appliance_extrainfo
560              
561             Takes an appliance id.
562              
563             Returns a hashref with additional infos about the appliance like its location.
564              
565             =head2 get_ha_groups_by_id
566              
567             Returns a hashref of HA groups indexed by their id.
568              
569             =head2 get_deployment
570              
571             Takes an appliance id.
572              
573             Returns a hashref containing the deployment data.
574              
575             =head2 get_interface_state
576              
577             Takes an interface id.
578              
579             Returns a hashref containing the interface state.
580              
581             =head2 get_interface_labels_by_type
582              
583             Returns a hashref containing the interface labels indexed by LAN/WAN and their id.
584              
585             =head2 list_template_applianceassociations
586              
587             Returns a hashref of template to appliances associations.
588              
589             =head2 list_applianceids_by_templategroupname
590              
591             Returns an arrayref of appliance IDs a templategroup is assigned to.
592              
593             =head2 list_addressgroups
594              
595             Returns an arrayref of address groups.
596              
597             =head2 list_addressgroup_names
598              
599             Returns an arrayref of address group names.
600              
601             =head2 get_addressgroup
602              
603             Returns an address group by name.
604              
605             =head2 create_or_update_addressgroup
606              
607             Takes an address group name and a hashref of address group config.
608              
609             Returns true on success.
610              
611             Throws an exception on error.
612              
613             =head2 update_addressgroup
614              
615             Takes an address group name and a hashref of address group config.
616              
617             Returns true on success.
618              
619             Throws an exception on error.
620              
621             =head2 delete_addressgroup
622              
623             Takes an address group name.
624              
625             Returns true on success.
626              
627             Throws an exception on error.
628              
629             =head2 list_servicegroups
630              
631             Returns an arrayref of service groups.
632              
633             =head2 list_servicegroup_names
634              
635             Returns an arrayref of service group names.
636              
637             =head2 get_servicegroup
638              
639             Returns a service group by name.
640              
641             =head2 create_or_update_servicegroup
642              
643             Takes a service group name and a hashref of service group config.
644              
645             Returns true on success.
646              
647             Throws an exception on error.
648              
649             =head2 update_servicegroup
650              
651             Takes a service group name and a hashref of service group config.
652              
653             Returns true on success.
654              
655             Throws an exception on error.
656              
657             =head2 delete_servicegroup
658              
659             Takes a service group name.
660              
661             Returns true on success.
662              
663             Throws an exception on error.
664              
665             =head2 list_domain_applications
666              
667             Returns an arrayref of domain name applications for a resource key which
668             defaults to 'userDefined'.
669              
670             =head2 create_or_update_domain_application
671              
672             Takes a domain name application domain, not name, and a hashref of its config.
673              
674             Returns true on success.
675              
676             Throws an exception on error.
677              
678             =head2 delete_domain_application
679              
680             Takes a domain name, not application name.
681              
682             Returns true on success.
683              
684             Throws an exception on error.
685              
686             =head2 list_application_groups
687              
688             Returns a hashref of application groups indexed by their name for a resource
689             key which defaults to 'userDefined'.
690              
691             =head2 create_or_update_application_group
692              
693             Takes a application group name, and a hashref of its config.
694              
695             Returns true on success.
696              
697             Throws an exception on error.
698              
699             Because there is no API endpoint for creating or editing a single application
700             group, this method has to load all application groups using
701             L<list_application_groups>, modify and then save them.
702              
703             =head2 delete_application_group
704              
705             Takes an application group name.
706              
707             Returns true on success.
708              
709             Throws an exception on error.
710              
711             Because there is no API endpoint for deleting a single application group,
712             this method has to load all application groups using
713             L<list_application_groups>, remove the requested application group and then
714             save them.
715              
716             =head1 KNOWN SILVERPEAK ORCHESTRATOR BUGS
717              
718             =over
719              
720             =item http 500 response on api key authentication
721              
722             Orchestrator versions before version 9.0.4 respond with a http 500 error on
723             every request using an api key that has no expiration date set.
724             The only workaround is to set an expiration date for it.
725              
726             =back
727              
728             =for Pod::Coverage has_user has_passwd has_api_key
729              
730             =for Pod::Coverage DEMOLISH
731              
732             =head1 AUTHOR
733              
734             Alexander Hartmaier <abraxxa@cpan.org>
735              
736             =head1 COPYRIGHT AND LICENSE
737              
738             This software is copyright (c) 2023 by Alexander Hartmaier.
739              
740             This is free software; you can redistribute it and/or modify it under
741             the same terms as the Perl 5 programming language system itself.
742              
743             =cut