File Coverage

blib/lib/BigIP/iControl.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package BigIP::iControl;
2              
3 1     1   26616 use strict;
  1         3  
  1         43  
4 1     1   5 use warnings;
  1         2  
  1         36  
5              
6 1     1   7 use Carp qw(confess croak);
  1         7  
  1         80  
7 1     1   6 use Exporter;
  1         1  
  1         36  
8 1     1   421 use SOAP::Lite;
  0            
  0            
9             use MIME::Base64;
10             use Math::BigInt;
11              
12             our $VERSION = '0.097';
13              
14             =head1 NAME
15              
16             BigIP::iControl - A Perl interface to the F5 iControl API
17              
18             =head1 SYNOPSIS
19              
20             use BigIP::iControl;
21              
22             my $ic = BigIP::iControl->new(
23             server => 'bigip.company.com',
24             username => 'api_user',
25             password => 'my_password',
26             port => 443,
27             proto => 'https'
28             );
29              
30             my $virtual = ($ic->get_vs_list())[0];
31              
32             my %stats = $ic->get_vs_statistics_stringified($virtual);;
33              
34             print '*'x50,"\nVirtual: $virtual\n",'*'x50,"\nTimestamp: $stats{timestamp}\n";
35              
36             foreach my $s (sort keys %{$stats{stats}}) {
37             print "$s\t$stats{stats}{$s}\n"
38             }
39              
40             =head1 DESCRIPTION
41              
42             This package provides a Perl interface to the F5 BigIP iControl API.
43              
44             The F5 BigIP iControl API is an open SOAP/XML for communicating with supported F5 BigIP products.
45              
46             The primary aim of this package is to provide a simplified interface to an already simple and
47             intutive API and to allow the user to do more with less code. By reducing the API invocations
48             to methods returning simple types, it is hoped that this module will provide a simple alternative
49             for common tasks.
50              
51             The secondary aim for this package is to provide a simple interface for accessing statistical
52             data from the iControl API for monitoring, recording, archival and display in other systems.
53             This objective has largely been obsoleted in v11 with the introduction of new statistical
54             monitoring and display features in the web UI.
55              
56             This package generally provides two methods for each each task; a raw method typically returning
57             the response as received from iControl, and a "stringified" method returning a parsed response.
58              
59             In general, the stringified methods will typically fufill most requirements and should usually
60             be easier to use.
61              
62             =cut
63              
64             our $urn_map;
65              
66             # Our implementation of the iControl API
67             # Refer to http://devcentral.f5.com/wiki/iControl.APIReference.ashx for complete detail.
68              
69             our $modules = {
70             ARX => {},
71             ASM => {},
72             Common => {},
73             GlobalLB => {
74             Pool => {
75             get_description => 'pool_names',
76             get_list => 0,
77             get_member => 'pool_names'
78             },
79             VirtualServer => {
80             get_all_statistics => 0,
81             get_enabled_state => 'virtual_servers',
82             get_list => 0
83             }
84             },
85             LTConfig => {},
86             LocalLB => {
87             VirtualServer => {
88             get_list => 0,
89             get_default_pool_name => 'virtual_servers',
90             get_destination => 'virtual_servers',
91             get_enabled_state => 'virtual_servers',
92             get_protocol => 'virtual_servers',
93             get_statistics => 'virtual_servers',
94             get_all_statistics => 0,
95             get_rule => 'virtual_servers',
96             get_snat_pool => 'virtual_servers',
97             get_snat_type => 'virtual_servers'
98             },
99             Pool => {
100             get_list => 0,
101             get_member => 'pool_names',
102             get_object_status => 'pool_names',
103             get_statistics => 'pool_names',
104             get_all_statistics => 'pool_names',
105             get_member_object_status=> {pool_names => 1, members => 1}
106             },
107             PoolMember => {
108             get_statistics => {pool_names => 1, members => 1},
109             get_all_statistics => 'pool_names',
110             },
111             NodeAddress => {
112             get_list => 0,
113             get_screen_name => 'node_addresses',
114             get_object_status => 'node_addresses',
115             get_monitor_status => 'node_addresses',
116             get_statistics => 'node_addresses'
117             },
118             Class => {
119             get_address_class_list => 0,
120             get_string_class_list => 0,
121             get_string_class => 'class_names',
122             get_string_class_member_data_value => 'class_members',
123             set_string_class_member_data_value => {class_members => 1, values => 1},
124             add_string_class_member => 'class_members',
125             delete_string_class_member=> 'class_members',
126             }
127             },
128             Management => {
129             DBVariable => {
130             query => 'variables'
131             },
132             EventSubscription=> {
133             create => 'sub_detail_list',
134             get_list => 0,
135             get_authentication => 'id_list',
136             get_state => 'id_list',
137             get_url => 'id_list',
138             get_proxy_url => 'id_list',
139             remove => 'id_list',
140             query => 'id_list'
141             }
142             },
143             Networking => {
144             Interfaces => {
145             get_list => 0,
146             get_enabled_state => {interfaces => 1},
147             get_media_speed => {interfaces => 1},
148             get_media_status => {interfaces => 1},
149             get_statistics => {interfaces => 1}
150             },
151             SelfIP => {
152             get_list => 0,
153             get_vlan => {self_ips => 1}
154             },
155             Trunk => {
156             get_interface => {trunks => 1},
157             get_lacp_enabled_state => {trunks => 1},
158             get_active_lacp_state => {trunks => 1},
159             get_list => 0,
160             get_configured_member_count=> {trunks => 1},
161             get_operational_member_count=> {trunks => 1},
162             get_media_speed => {trunks => 1},
163             get_media_status => {trunks => 1},
164             get_statistics => {trunks => 1}
165             }
166             },
167             System => {
168             ConfigSync => {
169             get_configuration_list => 0,
170             delete_configuration => {filename => 1},
171             save_configuration => {filename => 1, save_flag => 1},
172             download_file => {file_name => 1, chunk_size => 1, file_offset => 1},
173             download_configuration => {config_name => 1, chunk_size => 1, file_offset => 1}
174             },
175             SystemInfo => {
176             get_system_information => 0,
177             get_system_id => 0,
178             get_cpu_metrics => 0,
179             get_cpu_usage_extended_information=> 'host_ids'
180             },
181             Cluster => {
182             get_cluster_enabled_state=> 'cluster_names',
183             get_list => 0
184             },
185             Failover => {
186             get_failover_mode => 0,
187             get_failover_state => 0,
188             is_redundant => 0
189             },
190             Connections => {
191             get_list => 0,
192             get_all_active_connections=>0
193             },
194             Services => {
195             get_list => 0,
196             get_service_status => {services => 1},
197             get_all_service_statuses=> 0
198             }
199             },
200             WebAccelerator => {}
201             };
202              
203             our $event_types= {
204             EVENTTYPE_NONE => 1,
205             EVENTTYPE_TEST => 1,
206             EVENTTYPE_ALL => 1,
207             EVENTTYPE_SYSTEM_STARTUP => 1,
208             EVENTTYPE_SYSTEM_SHUTDOWN => 1,
209             EVENTTYPE_SYSTEM_CONFIG_LOAD => 1,
210             EVENTTYPE_CREATE => 1,
211             EVENTTYPE_MODIFY => 1,
212             EVENTTYPE_DELETE => 1,
213             EVENTTYPE_ADMIN_IP => 1,
214             EVENTTYPE_ARP_ENTRY => 1,
215             EVENTTYPE_DAEMON_HA => 1,
216             EVENTTYPE_DB_VARIABLE => 1,
217             EVENTTYPE_FEATURE_FLAGS => 1,
218             EVENTTYPE_FILTER_PROFILE => 1,
219             EVENTTYPE_GTMD => 1,
220             EVENTTYPE_INTERFACE => 1,
221             EVENTTYPE_LCDWARN => 1,
222             EVENTTYPE_L2_FORWARD => 1,
223             EVENTTYPE_MIRROR_PORT_MEMBER => 1,
224             EVENTTYPE_MIRROR_PORT => 1,
225             EVENTTYPE_MIRROR_VLAN => 1,
226             EVENTTYPE_MONITOR => 1,
227             EVENTTYPE_NAT => 1,
228             EVENTTYPE_NODE_ADDRESS => 1,
229             EVENTTYPE_PACKET_FILTER => 1,
230             EVENTTYPE_PCI_DEVICE => 1,
231             EVENTTYPE_POOL => 1,
232             EVENTTYPE_POOL_MEMBER => 1,
233             EVENTTYPE_RATE_FILTER => 1,
234             EVENTTYPE_ROUTE_MGMT => 1,
235             EVENTTYPE_ROUTE_UPDATE => 1,
236             EVENTTYPE_RULE => 1,
237             EVENTTYPE_SELF_IP => 1,
238             EVENTTYPE_SENSOR => 1,
239             EVENTTYPE_SNAT_ADDRESS => 1,
240             EVENTTYPE_SNAT_POOL => 1,
241             EVENTTYPE_SNAT_POOL_MEMBER => 1,
242             EVENTTYPE_STP => 1,
243             EVENTTYPE_SWITCH_DOMAIN => 1,
244             EVENTTYPE_SWITCH_EDGE => 1,
245             EVENTTYPE_TAMD_AUTH => 1,
246             EVENTTYPE_TRUNK => 1,
247             EVENTTYPE_TRUNK_CONFIG_MEMBER => 1,
248             EVENTTYPE_TRUNK_WORKING_MEMBER => 1,
249             EVENTTYPE_VALUE_LIST => 1,
250             EVENTTYPE_VIRTUAL_ADDRESS => 1,
251             EVENTTYPE_VIRTUAL_SERVER => 1,
252             EVENTTYPE_VIRTUAL_SERVER_PROFILE=> 1,
253             EVENTTYPE_VLAN => 1,
254             EVENTTYPE_VLAN_MEMBER => 1,
255             EVENTTYPE_VLANGROUP => 1
256             };
257              
258              
259             sub BEGIN {
260              
261             $urn_map= {
262             '{urn:iControl}ASM.ApplyLearningType' => 1,
263             '{urn:iControl}ASM.DynamicSessionsInUrlType' => 1,
264             '{urn:iControl}ASM.FlagState' => 1,
265             '{urn:iControl}ASM.PolicyTemplate' => 1,
266             '{urn:iControl}ASM.ProtocolType' => 1,
267             '{urn:iControl}ASM.SeverityName' => 1,
268             '{urn:iControl}ASM.ViolationName' => 1,
269             '{urn:iControl}ASM.WebApplicationLanguage' => 1,
270             '{urn:iControl}Common.ArmedState' => 1,
271             '{urn:iControl}Common.AuthenticationMethod' => 1,
272             '{urn:iControl}Common.AvailabilityStatus' => 1,
273             '{urn:iControl}Common.DaemonStatus' => 1,
274             '{urn:iControl}Common.EnabledState' => 1,
275             '{urn:iControl}Common.EnabledStatus' => 1,
276             '{urn:iControl}Common.FileChainType' => 1,
277             '{urn:iControl}Common.HAAction' => 1,
278             '{urn:iControl}Common.HAState' => 1,
279             '{urn:iControl}Common.IPHostType' => 1,
280             '{urn:iControl}Common.ProtocolType' => 1,
281             '{urn:iControl}Common.SourcePortBehavior' => 1,
282             '{urn:iControl}Common.StatisticType' => 1,
283             '{urn:iControl}Common.TMOSModule' => 1,
284             '{urn:iControl}GlobalLB.AddressType' => 1,
285             '{urn:iControl}GlobalLB.AutoConfigurationState' => 1,
286             '{urn:iControl}GlobalLB.AvailabilityDependency' => 1,
287             '{urn:iControl}GlobalLB.LBMethod' => 1,
288             '{urn:iControl}GlobalLB.LDNSProbeProtocol' => 1,
289             '{urn:iControl}GlobalLB.LinkWeightType' => 1,
290             '{urn:iControl}GlobalLB.MetricLimitType' => 1,
291             '{urn:iControl}GlobalLB.MonitorAssociationRemovalRule' => 1,
292             '{urn:iControl}GlobalLB.MonitorInstanceStateType' => 1,
293             '{urn:iControl}GlobalLB.MonitorRuleType' => 1,
294             '{urn:iControl}GlobalLB.RegionDBType' => 1,
295             '{urn:iControl}GlobalLB.RegionType' => 1,
296             '{urn:iControl}GlobalLB.ServerType' => 1,
297             '{urn:iControl}GlobalLB.Application.ApplicationObjectType' => 1,
298             '{urn:iControl}GlobalLB.DNSSECKey.KeyAlgorithm' => 1,
299             '{urn:iControl}GlobalLB.DNSSECKey.KeyType' => 1,
300             '{urn:iControl}GlobalLB.Monitor.IntPropertyType' => 1,
301             '{urn:iControl}GlobalLB.Monitor.StrPropertyType' => 1,
302             '{urn:iControl}GlobalLB.Monitor.TemplateType' => 1,
303             '{urn:iControl}LocalLB.AddressType' => 1,
304             '{urn:iControl}LocalLB.AuthenticationMethod' => 1,
305             '{urn:iControl}LocalLB.AvailabilityStatus' => 1,
306             '{urn:iControl}LocalLB.ClientSSLCertificateMode' => 1,
307             '{urn:iControl}LocalLB.ClonePoolType' => 1,
308             '{urn:iControl}LocalLB.CompressionMethod' => 1,
309             '{urn:iControl}LocalLB.CookiePersistenceMethod' => 1,
310             '{urn:iControl}LocalLB.CredentialSource' => 1,
311             '{urn:iControl}LocalLB.EnabledStatus' => 1,
312             '{urn:iControl}LocalLB.HardwareAccelerationMode' => 1,
313             '{urn:iControl}LocalLB.HttpChunkMode' => 1,
314             '{urn:iControl}LocalLB.HttpCompressionMode' => 1,
315             '{urn:iControl}LocalLB.HttpRedirectRewriteMode' => 1,
316             '{urn:iControl}LocalLB.LBMethod' => 1,
317             '{urn:iControl}LocalLB.MonitorAssociationRemovalRule' => 1,
318             '{urn:iControl}LocalLB.MonitorInstanceStateType' => 1,
319             '{urn:iControl}LocalLB.MonitorRuleType' => 1,
320             '{urn:iControl}LocalLB.MonitorStatus' => 1,
321             '{urn:iControl}LocalLB.PersistenceMode' => 1,
322             '{urn:iControl}LocalLB.ProfileContextType' => 1,
323             '{urn:iControl}LocalLB.ProfileMode' => 1,
324             '{urn:iControl}LocalLB.ProfileType' => 1,
325             '{urn:iControl}LocalLB.RamCacheCacheControlMode' => 1,
326             '{urn:iControl}LocalLB.RtspProxyType' => 1,
327             '{urn:iControl}LocalLB.SSLOption' => 1,
328             '{urn:iControl}LocalLB.ServerSSLCertificateMode' => 1,
329             '{urn:iControl}LocalLB.ServiceDownAction' => 1,
330             '{urn:iControl}LocalLB.SessionStatus' => 1,
331             '{urn:iControl}LocalLB.SnatType' => 1,
332             '{urn:iControl}LocalLB.TCPCongestionControlMode' => 1,
333             '{urn:iControl}LocalLB.TCPOptionMode' => 1,
334             '{urn:iControl}LocalLB.UncleanShutdownMode' => 1,
335             '{urn:iControl}LocalLB.VirtualAddressStatusDependency' => 1,
336             '{urn:iControl}LocalLB.Class.ClassType' => 1,
337             '{urn:iControl}LocalLB.Class.FileFormatType' => 1,
338             '{urn:iControl}LocalLB.Class.FileModeType' => 1,
339             '{urn:iControl}LocalLB.Monitor.IntPropertyType' => 1,
340             '{urn:iControl}LocalLB.Monitor.StrPropertyType' => 1,
341             '{urn:iControl}LocalLB.Monitor.TemplateType' => 1,
342             '{urn:iControl}LocalLB.ProfilePersistence.PersistenceHashMethod' => 1,
343             '{urn:iControl}LocalLB.ProfileUserStatistic.UserStatisticKey' => 1,
344             '{urn:iControl}LocalLB.RAMCacheInformation.RAMCacheVaryType' => 1,
345             '{urn:iControl}LocalLB.RateClass.DirectionType' => 1,
346             '{urn:iControl}LocalLB.RateClass.DropPolicyType' => 1,
347             '{urn:iControl}LocalLB.RateClass.QueueType' => 1,
348             '{urn:iControl}LocalLB.RateClass.UnitType' => 1,
349             '{urn:iControl}LocalLB.VirtualServer.VirtualServerCMPEnableMode' => 1,
350             '{urn:iControl}LocalLB.VirtualServer.VirtualServerType' => 1,
351             '{urn:iControl}Management.DebugLevel' => 1,
352             '{urn:iControl}Management.LDAPPasswordEncodingOption' => 1,
353             '{urn:iControl}Management.LDAPSSLOption' => 1,
354             '{urn:iControl}Management.LDAPSearchMethod' => 1,
355             '{urn:iControl}Management.LDAPSearchScope' => 1,
356             '{urn:iControl}Management.OCSPDigestMethod' => 1,
357             '{urn:iControl}Management.ZoneType' => 1,
358             '{urn:iControl}Management.EventNotification.EventDataType' => 1,
359             '{urn:iControl}Management.EventSubscription.AuthenticationMode' => 1,
360             '{urn:iControl}Management.EventSubscription.EventType' => 1,
361             '{urn:iControl}Management.EventSubscription.ObjectType' => 1,
362             '{urn:iControl}Management.EventSubscription.SubscriptionStatusCode' => 1,
363             '{urn:iControl}Management.KeyCertificate.CertificateType' => 1,
364             '{urn:iControl}Management.KeyCertificate.KeyType' => 1,
365             '{urn:iControl}Management.KeyCertificate.ManagementModeType' => 1,
366             '{urn:iControl}Management.KeyCertificate.SecurityType' => 1,
367             '{urn:iControl}Management.KeyCertificate.ValidityType' => 1,
368             '{urn:iControl}Management.Provision.ProvisionLevel' => 1,
369             '{urn:iControl}Management.SNMPConfiguration.AuthType' => 1,
370             '{urn:iControl}Management.SNMPConfiguration.DiskCheckType' => 1,
371             '{urn:iControl}Management.SNMPConfiguration.LevelType' => 1,
372             '{urn:iControl}Management.SNMPConfiguration.ModelType' => 1,
373             '{urn:iControl}Management.SNMPConfiguration.PrefixType' => 1,
374             '{urn:iControl}Management.SNMPConfiguration.PrivacyProtocolType' => 1,
375             '{urn:iControl}Management.SNMPConfiguration.SinkType' => 1,
376             '{urn:iControl}Management.SNMPConfiguration.TransportType' => 1,
377             '{urn:iControl}Management.SNMPConfiguration.ViewType' => 1,
378             '{urn:iControl}Management.UserManagement.UserRole' => 1,
379             '{urn:iControl}Networking.FilterAction' => 1,
380             '{urn:iControl}Networking.FlowControlType' => 1,
381             '{urn:iControl}Networking.LearningMode' => 1,
382             '{urn:iControl}Networking.MediaStatus' => 1,
383             '{urn:iControl}Networking.MemberTagType' => 1,
384             '{urn:iControl}Networking.MemberType' => 1,
385             '{urn:iControl}Networking.PhyMasterSlaveMode' => 1,
386             '{urn:iControl}Networking.RouteEntryType' => 1,
387             '{urn:iControl}Networking.STPLinkType' => 1,
388             '{urn:iControl}Networking.STPModeType' => 1,
389             '{urn:iControl}Networking.STPRoleType' => 1,
390             '{urn:iControl}Networking.STPStateType' => 1,
391             '{urn:iControl}Networking.ARP.NDPState' => 1,
392             '{urn:iControl}Networking.Interfaces.MediaType' => 1,
393             '{urn:iControl}Networking.ProfileWCCPGRE.WCCPGREForwarding' => 1,
394             '{urn:iControl}Networking.STPInstance.PathCostType' => 1,
395             '{urn:iControl}Networking.SelfIPPortLockdown.AllowMode' => 1,
396             '{urn:iControl}Networking.Trunk.DistributionHashOption' => 1,
397             '{urn:iControl}Networking.Trunk.LACPTimeoutOption' => 1,
398             '{urn:iControl}Networking.Trunk.LinkSelectionPolicy' => 1,
399             '{urn:iControl}Networking.Tunnel.TunnelDirection' => 1,
400             '{urn:iControl}Networking.VLANGroup.VLANGroupTransparency' => 1,
401             '{urn:iControl}Networking.iSessionLocalInterface.NatSourceAddress' => 1,
402             '{urn:iControl}Networking.iSessionPeerDiscovery.DiscoveryMode' => 1,
403             '{urn:iControl}Networking.iSessionPeerDiscovery.FilterMode' => 1,
404             '{urn:iControl}Networking.iSessionRemoteInterface.NatSourceAddress' => 1,
405             '{urn:iControl}Networking.iSessionRemoteInterface.OriginState' => 1,
406             '{urn:iControl}System.CPUMetricType' => 1,
407             '{urn:iControl}System.FanMetricType' => 1,
408             '{urn:iControl}System.HardwareType' => 1,
409             '{urn:iControl}System.PSMetricType' => 1,
410             '{urn:iControl}System.TemperatureMetricType' => 1,
411             '{urn:iControl}System.ConfigSync.ConfigExcludeComponent' => 1,
412             '{urn:iControl}System.ConfigSync.ConfigIncludeComponent' => 1,
413             '{urn:iControl}System.ConfigSync.LoadMode' => 1,
414             '{urn:iControl}System.ConfigSync.SaveMode' => 1,
415             '{urn:iControl}System.ConfigSync.SyncMode' => 1,
416             '{urn:iControl}System.Disk.RAIDStatus' => 1,
417             '{urn:iControl}System.Failover.FailoverMode' => 1,
418             '{urn:iControl}System.Failover.FailoverState' => 1,
419             '{urn:iControl}System.Services.ServiceAction' => 1,
420             '{urn:iControl}System.Services.ServiceStatusType' => 1,
421             '{urn:iControl}System.Services.ServiceType' => 1,
422             '{urn:iControl}System.Statistics.GtmIQueryState' => 1,
423             '{urn:iControl}System.Statistics.GtmPathStatisticObjectType' => 1,
424             };
425              
426             package BigIP::iControlDeserializer;
427             @BigIP::iControlDeserializer::ISA = 'SOAP::Deserializer';
428              
429             sub typecast {
430             my ($self, $value, $name, $attrs, $children, $type) = @_;
431             my $retval = undef;
432             if (not defined $type or not defined $urn_map->{$type}) {return $retval}
433             if ($urn_map->{$type} == 1) {$retval = $value}
434             return $retval;
435             }
436             }
437              
438             =head2 METHODS
439              
440             =head3 new (%args)
441              
442             my $ic = BigIP::iControl->new(
443             server => 'bigip.company.com',
444             username => 'api_user',
445             password => 'my_password',
446             port => 443,
447             proto => 'https',
448             verify_hostname => 0
449             );
450              
451             Constructor method. Creates a new BigIP::iControl object representing a single interface into the iControl
452             API of the target system.
453              
454             Required parameters are:
455              
456             =over 3
457              
458             =item server
459              
460             The target F5 BIGIP device. The supplied value may be either an IP address, FQDN or resolvable hostname.
461              
462             =item username
463              
464             The username with which to connect to the iControl API.
465              
466             =item password
467              
468             The password with which to connect to the iControl API.
469              
470             =item port
471              
472             The port on which to connect to the iControl API. If not specified this value will default to 443.
473              
474             =item proto
475              
476             The protocol with to use for communications with the iControl API (should be either http or https). If not specified
477             this value will default to https.
478              
479             =item verify_hostname
480              
481             If TRUE when used with a secure connection then the client will ensure that the target server has a valid certificate
482             matching the expected hostname.
483              
484             =back
485              
486             =cut
487              
488             sub new {
489             my ($class, %args) = @_;
490             my $self = bless {}, $class;
491             defined $args{server} ? $self->{server} = $args{server} : croak 'Constructor failed: server not defined';
492             defined $args{username} ? $self->{username} = $args{username} : croak 'Constructor failed: username not defined';
493             defined $args{password} ? $self->{password} = $args{password} : croak 'Constructor failed: password not defined';
494             $self->{proto} = ($args{proto} or 'https');
495             $self->{port} = ($args{port} or '443');
496             $self->{_client} = SOAP::Lite ->proxy($self->{proto}.'://'.$self->{server}.':'.$self->{port}.'/iControl/iControlPortal.cgi')
497             ->deserializer(BigIP::iControlDeserializer->new());
498             $self->{_client}->transport->http_request->header('Authorization' => 'Basic ' . MIME::Base64::encode("$self->{username}:$self->{password}") );
499             eval { $self->{_client}->transport->ssl_opts( verify_hostname => $args{verify_hostname} ) };
500             return $self;
501             }
502              
503             sub _set_uri {
504             my ($self, $module, $interface) = @_;
505             $self->{_client}->uri("urn:iControl:$module/$interface");
506             return 1
507             }
508              
509             sub _unset_uri {
510             undef $_[0]->{_client}->{uri};
511             }
512              
513             sub _get_username {
514             return $_[0]->{username};
515             }
516              
517             # We do most of our request validation in this method so it is unnessecarily complex, not entirely intuitive, uglier
518             # than a hat full of assholes and slightly less elegant than Lindsay Lohan exiting a limo.
519             #
520             # By pushing complexity from our public methods into here, we can implement some basic checks against known bad
521             # invocations rather than just passing them through to iControl to handle.
522             #
523             # It also allows us to limit the over-riding or abuse of the internal _request method by limiting
524             # invocations to the parameter format specified in global $modules struct.
525             #
526             # We can then implement accessor methods by essentially copying the API invocation from the reference. For example,
527             # to implement the System::SystemInfo::get_system_id API call, the reference gives the prototype as;
528             #
529             # String get_system_id();
530             #
531             # Note also that the API uses the namespace convention of Module::Interface::Method, so that our get_system_id method
532             # is implemented in the SystemInfo interface, which is under the System module.
533             #
534             # Implementing this, we would first add the method to our $modules struct maintaining the API heirarchy;
535             #
536             # $modules => {
537             # System => {
538             # SystemInfo => {
539             # get_system_id => 0
540             #
541             # Analogous to:
542             #
543             # $modules => {
544             # Module => {
545             # Interface => {
546             # Method => parameters
547             #
548             # A value of 0 is used for get_system_id as the method prototype takes no parameters. For methods taking a single
549             # parameter, we would use the value of the required parameter name, for methods taking numerous parameters, we would
550             # use a hash containing a key for each parameter.
551             #
552             # Our method is then created as an invocation to the private _request method setting the value of the module,
553             # interface and method arguments as per the API reference. i.e.
554             #
555             # module => 'System'
556             # interface => 'SystemInfo'
557             # method => 'get_system_id'
558             #
559             # Which is intuitively translated into the implementation below;
560             #
561             # sub get_cluster_enabled_state {
562             # my $self = shift;
563             # return $self->_request(module => 'System', interface => 'Cluster', method => 'get_cluster_enabled_state');
564             # }
565             #
566              
567             sub _request {
568             my ($self, %args)= @_;
569             $args{module} and exists $modules->{$args{module}}
570             or return 'Request error: unknown module name: "'.$args{module}.'"';
571             $args{interface}and exists $modules->{$args{module}}->{$args{interface}}
572             or return "Request error: unknown interface name for module $args{module}: \"$args{interface}\"";
573             $args{method} and exists $modules->{$args{module}}->{$args{interface}}->{$args{method}}
574             or return "Request error: unknown method name for module $args{module} and interface $args{interface}: \"$args{method}\"";
575              
576             my @params = ();
577              
578             if ($modules->{$args{module}}->{$args{interface}}->{$args{method}}) {
579              
580             foreach my $arg (keys %{$args{data}}) {
581              
582             if (ref $modules->{$args{module}}->{$args{interface}}->{$args{method}} eq 'HASH') {
583             exists $modules->{$args{module}}->{$args{interface}}->{$args{method}}->{$arg}
584             or croak "Request error: method $args{method} for interface $args{interface} in module $args{module} requires " .
585             "mandatory data parameter \"$modules->{$args{module}}->{$args{interface}}->{$args{method}}->{$arg}\"";
586             push @params, SOAP::Data->name($arg => $args{data}{$arg});
587             }
588             else {
589             $arg eq $modules->{$args{module}}->{$args{interface}}->{$args{method}}
590             or croak "Request error: method $args{method} for interface $args{interface} in module $args{module} requires " .
591             "mandatory data parameter \"$modules->{$args{module}}->{$args{interface}}->{$args{method}}\"";
592             push @params, SOAP::Data->name(%{$args{data}});
593             }
594             }
595             }
596              
597             $self->_set_uri($args{module}, $args{interface});
598             my $method = $args{method};
599             my $query = $self->{_client}->$method(@params);
600             $query->fault and confess('SOAP call failed: ', $query->faultstring());
601             $self->_unset_uri();
602             return $query->result;
603             }
604              
605             sub __get_timestamp {
606             my $time;
607             my %ts;
608             @ts{qw(year month day hour minute second)} = ((localtime(time))[5,4,3,2,1,0]);
609             $ts{year}+=1900;
610             $ts{month}++;
611              
612             foreach (keys %ts) {
613             $time->{$_} = $ts{$_};
614             }
615            
616             return __process_timestamp($time);
617             }
618              
619             sub __process_timestamp {
620             my $time_stamp = shift;
621             return (__zero_fill($time_stamp->{year}) . '-' .
622             __zero_fill($time_stamp->{month}) . '-' .
623             __zero_fill($time_stamp->{day}) . '-' .
624             __zero_fill($time_stamp->{hour}) . '-' .
625             __zero_fill($time_stamp->{minute}) . '-' .
626             __zero_fill($time_stamp->{second}))
627             }
628              
629             sub __process_statistics {
630             my $statistics = shift;
631              
632             my %stat_obj = (timestamp => __process_timestamp($statistics->{time_stamp}));
633              
634             foreach (@{@{$statistics->{statistics}}[0]->{statistics}}) {
635             my $type = $_->{type};
636             $stat_obj{stats}{$type} = Math::BigInt->new("0x" . unpack("H*", pack("N2",$_->{value}{high}, $_->{value}{low})))->bstr;
637             }
638            
639             return %stat_obj
640             }
641              
642             sub __process_pool_member_statistics {
643             my $statistics = shift;
644             my $timestamp = @{$statistics}[0]->{time_stamp};
645             my %stat_obj;
646              
647             foreach (@{@{$statistics}[0]->{statistics}}) {
648             my $node = $_->{member}->{address}.':'.$_->{member}->{port};
649             $stat_obj{$node}= {__process_statistics( { time_stamp => $timestamp, statistics => [ $_ ] } )};
650             }
651            
652             return %stat_obj
653             }
654              
655             sub __process_cpu_statistics {
656             my $statistics = shift;
657             my $cpu_cnt = 0;
658             my %stat_obj = (timestamp => __get_timestamp);
659              
660             foreach my $cpu (@{$statistics}) {
661              
662             foreach (@{$cpu}) {
663             $stat_obj{stats}{$cpu_cnt}{$_->{type}} = (($_->{value}{high})<<32)|(abs $_->{value}{low});
664             }
665            
666             $cpu_cnt++;
667             }
668              
669             return %stat_obj
670             }
671              
672             sub __zero_fill {
673             return ($_[0] < 10 ? '0' . $_[0] : $_[0])
674             }
675              
676             =head3 get_system_information
677              
678             Return a SystemInformation struct containing the identifying attributes of the operating system.
679             The struct information is described below;
680              
681             Member Type Description
682             ---------- ---------- ----------
683             system_name String The name of the operating system implementation.
684             host_name String The host name of the system.
685             os_release String The release level of the operating system.
686             os_machine String The hardware platform CPU type.
687             os_version String The version string for the release of the operating system.
688             platform String The platform of the device.
689             product_category String The product category of the device.
690             chassis_serial String The chassis serial number.
691             switch_board_serial String The serial number of the switch board.
692             switch_board_part_revision String The part revision number of the switch board.
693             host_board_serial String The serial number of the host motherboard.
694             host_board_part_revision String The part revision number of the host board.
695             annunciator_board_serial String The serial number of the annuciator board.
696             annunciator_board_part_revision String The part revision number of the annunciator board.
697              
698             =cut
699              
700             sub get_system_information {
701             return $_[0]->_request(module => 'System', interface => 'SystemInfo', method => 'get_system_information')
702             }
703              
704             =head3 get_system_id ()
705              
706             Gets the unique identifier for the system.
707              
708             =cut
709              
710             sub get_system_id {
711             return $_[0]->_request(module => 'System', interface => 'SystemInfo', method => 'get_system_id')
712             }
713              
714             =head3 get_cpu_metrics ()
715              
716             Gets the CPU metrics for the CPU(s) on the platform.
717              
718             =cut
719              
720             sub get_cpu_metrics {
721             return $_[0]->_request(module => 'System', interface => 'SystemInfo', method => 'get_cpu_metrics');
722             }
723              
724             =head3 get_cpu_metrics_stringified ()
725              
726             Gets the CPU metrics for the CPU(s) on the platform.
727              
728             =cut
729              
730             sub get_cpu_metrics_stringified {
731             my $self = shift;
732             my $res;
733              
734             my $metrics = $self->get_cpu_metrics;
735             $res->{timestamp}= __get_timestamp;
736              
737             foreach (@{$metrics->{cpus}}) {
738             $res->{@{$_}[0]->{value}}->{temp} = @{$_}[1]->{value};
739             $res->{@{$_}[0]->{value}}->{fan} = @{$_}[2]->{value};
740             }
741              
742             return $res
743             }
744              
745             sub __get_cpu_metric {
746             my($self,$cpu,$metric)=@_;
747             my $metrics = $self->get_cpu_metrics_stringified();
748             exists $metrics->{$cpu} and return $metrics->{$cpu}->{$metric};
749             }
750              
751             =head3 get_cpu_fan_speed ($cpu)
752              
753             Returns the current CPU fan speed in RPM for the specified CPU.
754              
755             =cut
756              
757             sub get_cpu_fan_speed {
758             return $_[0]->__get_cpu_metric($_[1],'fan')
759             }
760              
761             =head3 get_cpu_temp ($cpu)
762              
763             Returns the current CPU temperature degrees celcius for the specified CPU.
764              
765             =cut
766              
767             sub get_cpu_temp {
768             return $_[0]->__get_cpu_metric($_[1],'temp')
769             }
770              
771             =head3 get_cpu_usage_extended_information ()
772              
773             =cut
774              
775             sub get_cpu_usage_extended_information {
776             my($self,$id) = @_;
777             $id ||= $self->{server};
778             return $self->_request(module => 'System', interface => 'SystemInfo', method => 'get_cpu_usage_extended_information', data => {host_ids => [$id]});
779             }
780              
781             =head3 get_cpu_usage_extended_information_stringified ()
782              
783             =cut
784              
785             sub get_cpu_usage_extended_information_stringified {
786             my($self,$id) = shift;
787             __process_cpu_statistics(@{$self->get_cpu_usage_extended_information($id)->{hosts}}[0]->{statistics});
788             }
789              
790             =head3 get_cluster_list ()
791              
792             Gets a list of the cluster names.
793              
794             =cut
795              
796             sub get_cluster_list {
797             return $_[0]->_request(module => 'System', interface => 'Cluster', method => 'get_list');
798             }
799              
800             =head3 get_failover_mode ()
801              
802             Gets the current fail-over mode that the device is running in.
803              
804             =cut
805              
806             sub get_failover_mode {
807             return $_[0]->_request(module => 'System', interface => 'Failover', method => 'get_failover_mode');
808             }
809              
810             =head3 get_failover_state ()
811              
812             Gets the current fail-over state that the device is running in.
813              
814             =cut
815              
816             sub get_failover_state {
817             return $_[0]->_request(module => 'System', interface => 'Failover', method => 'get_failover_state');
818             }
819              
820             =head3 is_redundant ()
821              
822             Returns a boolean indicating the redundancy state of the device.
823              
824             =cut
825              
826             sub is_redundant {
827             return $_[0]->_request(module => 'System', interface => 'Failover', method => 'is_redundant');
828             }
829              
830             =head3 get_cluster_enabled_state ()
831              
832             Gets the cluster enabled states.
833              
834             =cut
835              
836             sub get_cluster_enabled_state {
837             return $_[0]->_request(module => 'System', interface => 'Cluster', method => 'get_cluster_enabled_state');
838             }
839              
840             =head3 get_service_list ()
841              
842             Returns a list of all supported services on this host.
843              
844             =cut
845              
846             sub get_service_list {
847             return @{$_[0]->_request(module => 'System', interface => 'Services', method => 'get_list')}
848             }
849              
850             =head3 get_service_status ()
851              
852             Returns the status of the specified service.
853              
854             =cut
855              
856             sub get_service_status {
857             my($self,$service)= shift;
858             return $self->_request(module => 'System', interface => 'Services', method => 'get_service_status', data => { services => $service });
859             }
860              
861             =head3 get_all_service_statuses ()
862              
863             Returns the status of all services.
864              
865             =cut
866              
867             sub get_all_service_statuses {
868             my $self = shift;
869             my %res;
870              
871             foreach my $service (@{$self->_request(module => 'System', interface => 'Services', method => 'get_all_service_statuses')}) {
872             $res{$service->{service}} = $service->{status}
873             }
874              
875             return %res
876             }
877              
878             =head3 save_configuration ($filename)
879              
880             $ic->save_configuration('backup.ucs');
881              
882             # is equivalent to
883              
884             $ic->save_configuration('backup');
885            
886             # Not specifying a filename will use today's date in the
887             # format YYYYMMDD as the filename.
888              
889             $ic->save_configuration();
890              
891             # is equivalent to
892              
893             $ic->save_configuration('today');
894            
895              
896             Saves the current configurations on the target device.
897              
898             This method takes a single optional parameter; the filename to which the configuration should be saved. The file
899             extension B<.ucs> will be suffixed to the filename if missing from the supplied filename.
900              
901             Specifying no optional filename parameter or using the filename B will use the current date as the filename
902             of the saved configuration file in the format B.
903              
904             =cut
905              
906             sub __save_configuration {
907             my ($self,$filename,$flag) = @_;
908              
909             if (($filename eq 'today') or ($filename eq '')) {
910             $filename = __get_timestamp();
911             }
912            
913             $flag or $flag = 'SAVE_FULL';
914              
915             $self->_request(module => 'System', interface => 'ConfigSync', method => 'save_configuration', data => { filename => $filename, save_flag => $flag});
916              
917             return 1
918             }
919              
920             sub save_configuration {
921             my ($self,$filename) = @_;
922             return ($self->__save_configuration($filename,'SAVE_FULL'));
923             }
924              
925             =head3 save_base_configuration ()
926              
927             $ic->save_base_configuration();
928              
929             Saves only the base configuration (VLANs, self IPs...). The filename specified when used with this mode will
930             be ignored, since configuration will be saved to /config/bigip_base.conf by default.
931              
932             =cut
933              
934             sub save_base_configuration {
935             return ($_[0]->__save_configuration('ignore','SAVE_BASE_LEVEL_CONFIG'))
936             }
937              
938             =head3 save_high_level_configuration ()
939              
940             $ic->save_high_level_configuration();
941              
942             Saves only the high-level configuration (virtual servers, pools, members, monitors...). The filename specified
943             when used with this mode will be ignored, since configuration will be saved to /config/bigip.conf by default.
944              
945             =cut
946              
947             sub save_high_level_configuration {
948             return ($_[0]->__save_configuration('ignore','SAVE_HIGH_LEVEL_CONFIG'))
949             }
950              
951              
952             =head3 download_configuration ($filename)
953              
954             This method downloads a saved UCS configuration from the target device.
955              
956             =cut
957              
958             sub download_configuration {
959             my ($self,$config_name,$local_file) = @_;
960             my $chunk = 65536;
961             my $offset = 0;
962             my $data;
963              
964             $config_name or croak 'No configuration file specified';
965              
966             open my $fh, '+>', $local_file or croak "Unable to open local file: $local_file";
967             binmode($fh);
968              
969             while (1) {
970             $data = $self->_request(module => 'System', interface => 'ConfigSync', method => 'download_configuration', data => {config_name => $config_name, chunk_size => $chunk, file_offset => $offset});
971             print $fh $data->{file_data};
972             last if (($data->{chain_type} eq 'FILE_LAST') or ($data->{chain_type} eq 'FILE_FIRST_AND_LAST'));
973             $offset+=(length($data->{file_data}));
974             }
975              
976             close $fh;
977             return 1
978             }
979              
980             =head3 get_configuration_list ()
981              
982             my %config_list = $ic->get_configuration_list();
983              
984             Returns a list of the configuration archives present on the system. the list is returned as a hash
985             with the name of the configuration archive as the key, and the creation date of the configuration
986             archive as the value.
987              
988             The creation date uses the native date format of:
989              
990             Day Mon D HH:MM:SS YYYY
991              
992             Where B is the three-letter common abbreviation of the day name, B is the three letter common
993             abbreviation of the month name and B has the value range 1-31 with no leading zeros.
994              
995             =cut
996              
997             sub get_configuration_list {
998             my $self = shift;
999             my %res;
1000              
1001             foreach (@{$self->_request(module => 'System', interface => 'ConfigSync', method => 'get_configuration_list')}) {
1002             $res{$_->{file_name}} = $_->{file_datetime}
1003             }
1004              
1005             return %res;
1006             }
1007              
1008             =head3 delete_configuration ()
1009              
1010             $ic->delete_configuration('file.ucs');
1011              
1012             Deletes the specified configuration archive from the system.
1013              
1014             =cut
1015              
1016             sub delete_configuration {
1017             my ($self,$filename) = @_;
1018             $filename or croak 'No filename specified';
1019             return $self->_request(module => 'System', interface => 'ConfigSync', method => 'delete_configuration', data => { filename => $filename });
1020             }
1021              
1022             sub _download_file {
1023             my ($self,$config_name,$local_file) = @_;
1024             my $chunk = 65536;
1025             my $offset = 0;
1026             my $data;
1027              
1028             $config_name or croak 'No configuration file specified';
1029              
1030             open my $fh, '+>', $local_file or croak "Unable to open local file: $local_file";
1031             binmode($fh);
1032              
1033             while (1) {
1034             $data = $self->_request(module => 'System', interface => 'ConfigSync', method => 'download_configuration', data => {config_name => $config_name, chunk_size => $chunk, file_offset => $offset});
1035             print $fh $data->{file_data};
1036             last if (($data->{chain_type} eq 'FILE_LAST') or ($data->{chain_type} eq 'FILE_FIRST_AND_LAST'));
1037             $offset+=(length($data->{file_data}));
1038             }
1039              
1040             close $fh;
1041             return 1
1042             }
1043              
1044             =head3 download_file ( $FILE )
1045              
1046             # Print the bigip.conf file to the terminal
1047             print $ic->download_file('/config/bigip.conf');
1048              
1049             This method provides direct access to files on the target system. The method returns a scalar containing
1050             the contents of the file.
1051              
1052             This method may be useful for downloading configuration files for versioning or backups.
1053              
1054             =cut
1055              
1056             sub download_file {
1057             my ($self,$file_name) = @_;
1058             my $chunk = 65536;
1059             my $offset = 0;
1060             my ($data, $output);
1061              
1062             $file_name or croak 'No file name specified';
1063              
1064             while (1) {
1065             $data = $self->_request(module => 'System', interface => 'ConfigSync', method => 'download_file', data => {file_name => $file_name, chunk_size => $chunk, file_offset => $offset});
1066             $output .=$data->{file_data};
1067             last if (($data->{chain_type} eq 'FILE_LAST') or ($data->{chain_type} eq 'FILE_FIRST_AND_LAST'));
1068             $offset+=(length($data->{file_data}));
1069             }
1070              
1071             return $output
1072             }
1073              
1074             =head3 get_interface_list ()
1075              
1076             my @interfaces = $ic->get_interface_list();
1077              
1078             Retuns an ordered list of all interfaces on the target device.
1079              
1080             =cut
1081              
1082             sub get_interface_list {
1083             return sort @{$_[0]->_request(module => 'Networking', interface => 'Interfaces', method => 'get_list')};
1084             }
1085              
1086             =head3 get_interface_enabled_state ($interface)
1087              
1088             Returns the enabled state of the specific interface.
1089              
1090             =cut
1091              
1092             sub get_interface_enabled_state {
1093             my ($self, $inet)=@_;
1094             return @{$self->_request(module => 'Networking', interface => 'Interfaces', method => 'get_enabled_state', data => { interfaces => [$inet] })}[0]
1095             }
1096              
1097             =head3 get_interface_media_status ($interface)
1098              
1099             Returns the media status of the specific interface.
1100              
1101             =cut
1102              
1103             sub get_interface_media_status {
1104             my ($self, $inet)=@_;
1105             return @{$self->_request(module => 'Networking', interface => 'Interfaces', method => 'get_media_status', data => { interfaces => [$inet] })}[0]
1106             }
1107              
1108             =head3 get_interface_media_speed ($interface)
1109              
1110             Returns the media speed of the specific interface in Mbps.
1111              
1112             =cut
1113              
1114             sub get_interface_media_speed {
1115             my ($self, $inet)=@_;
1116             return @{$self->_request(module => 'Networking', interface => 'Interfaces', method => 'get_media_speed', data => { interfaces => [$inet] })}[0]
1117             }
1118              
1119             =head3 get_interface_statistics ($interface)
1120              
1121             Returns all statistics for the specified interface as a InterfaceStatistics object. Unless you specifically
1122             require access to the raw object, consider using B for a pre-parsed hash
1123             in an easy-to-digest format.
1124              
1125             =cut
1126              
1127             sub get_interface_statistics {
1128             my ($self, $inet)=@_;
1129             return $self->_request(module => 'Networking', interface => 'Interfaces', method => 'get_statistics', data => { interfaces => [$inet] })
1130             }
1131              
1132             =head3 get_interface_statistics_stringified ($interface)
1133              
1134             my $inet = ($ic->get_interface_list())[0];
1135             my %stats = $ic->get_interface_statistics_stringified($inet);
1136              
1137             print "Interface: $inet - Bytes in: $stats{stats}{STATISTIC_BYTES_IN} - Bytes out: STATISTIC_BYTES_OUT";
1138              
1139             Returns all statistics for the specified interface as a hash having the following structure;
1140              
1141             {
1142             timestamp => 'YYYY-MM-DD-hh-mm-ss',
1143             stats => {
1144             statistic_1 => value
1145             ...
1146             statistic_n => value
1147             }
1148             }
1149              
1150             Where the keys of the stats hash are the names of the statistic types defined in a InterfaceStatistics object.
1151             Refer to the official API documentation for the exact structure of the InterfaceStatistics object.
1152              
1153             =cut
1154              
1155             sub get_interface_statistics_stringified {
1156             my ($self, $inet)=@_;
1157             return __process_statistics($self->get_interface_statistics($inet))
1158             }
1159              
1160             =head3 get_trunk_list ()
1161              
1162             my @trunks = $ic->get_trunk_list();
1163              
1164             Returns an array of the configured trunks present on the device.
1165              
1166             =cut
1167              
1168             sub get_trunk_list {
1169             return @{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_list')};
1170             }
1171              
1172             =head3 get_active_trunk_members ()
1173              
1174             print "Trunk $t has " . $ic->get_active_trunk_members() . " active members.\n";
1175              
1176             Returns the number of the active members for the specified trunk.
1177              
1178             =cut
1179              
1180             sub get_active_trunk_members {
1181             my ($self, $trunk) = @_;
1182             return @{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_operational_member_count', data => { trunks => [ $trunk ] })}[0]
1183             }
1184              
1185             =head3 get_configured_trunk_members ()
1186              
1187             print "Trunk $t has " . $ic->get_configured_trunk_members() . " configured members.\n";
1188              
1189             Returns the number of configured members for the specified trunk.
1190              
1191             =cut
1192              
1193             sub get_configured_trunk_members {
1194             my ($self, $trunk) = @_;
1195             return @{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_configured_member_count', data => { trunks => [ $trunk ] })}[0]
1196             }
1197              
1198             =head3 get_trunk_interfaces ()
1199              
1200             my @t_inets = $ic->get_trunk_interfaces();
1201              
1202             Returns an array containing the interfaces of the members of the specified trunk.
1203              
1204             =cut
1205              
1206             sub get_trunk_interfaces {
1207             my ($self, $trunk) = @_;
1208             return @{@{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_interface', data => { trunks => [ $trunk ] })}[0]}
1209             }
1210              
1211             =head3 get_trunk_media_speed ()
1212              
1213             print "Trunk $t operating at " . $ic->get_trunk_media_speed($t) . "Mbps\n";
1214              
1215             Returns the current operational media speed (in Mbps) of the specified trunk.
1216              
1217             =cut
1218              
1219             sub get_trunk_media_speed {
1220             my ($self, $trunk) = @_;
1221             return @{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_media_speed', data => { trunks => [ $trunk ] })}[0]
1222             }
1223              
1224             =head3 get_trunk_media_status ()
1225              
1226             print "Trunk $t media status is " . $ic->get_trunk_media_status($t) . "\n";
1227              
1228             Returns the current operational media status of the specified trunk.
1229              
1230             =cut
1231              
1232             sub get_trunk_media_status {
1233             my ($self, $trunk) = @_;
1234             return @{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_media_status', data => { trunks => [ $trunk ] })}[0]
1235             }
1236              
1237             =head3 get_trunk_lacp_enabled_state ()
1238              
1239             Returns the enabled state of LACP for the specified trunk.
1240              
1241             =cut
1242              
1243             sub get_trunk_lacp_enabled_state {
1244             my ($self, $trunk) = @_;
1245             return @{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_lacp_enabled_state', data => { trunks => [ $trunk ] })}[0]
1246             }
1247              
1248             =head3 get_trunk_lacp_active_state ()
1249              
1250             Returns the active state of LACP for the specified trunk.
1251              
1252             =cut
1253              
1254             sub get_trunk_lacp_active_state {
1255             my ($self, $trunk) = @_;
1256             return @{$_[0]->_request(module => 'Networking', interface => 'Trunk', method => 'get_active_lacp_state', data => { trunks => [ $trunk ] })}[0]
1257             }
1258              
1259             =head3 get_trunk_statistics ()
1260              
1261             Returns the traffic statistics for the specified trunk. The statistics are returned as a TrunkStatistics object
1262             hence this method is useful where access to raw statistical data is required.
1263              
1264             For parsed statistic data, see B.
1265              
1266             For specific information regarding data and units of measurement for statistics methods, please see the B section.
1267              
1268             =cut
1269              
1270             sub get_trunk_statistics {
1271             my ($self, $trunk) = @_;
1272             return $self->_request(module => 'Networking', interface => 'Trunk', method => 'get_statistics', data => { trunks => [ $trunk ] })
1273             }
1274              
1275             =head3 get_trunk_statistics_stringified ()
1276              
1277             Returns all statistics for the specified trunk as a hash of hases with the following structure:
1278              
1279             {
1280             timestamp => 'yyyy-mm-dd-hh-mm-ss',
1281             stats => {
1282             stats_1 => value,
1283             stats_3 => value,
1284             ...
1285             stats_n => value
1286             }
1287             }
1288            
1289             This function accepts a single parameter; the trunk for which the statistics are to be returned.
1290              
1291             For specific information regarding data and units of measurement for statistics methods, please see the B section.
1292              
1293             =cut
1294              
1295             sub get_trunk_statistics_stringified {
1296             my ($self, $trunk) = @_;
1297             return __process_statistics($self->get_trunk_statistics($trunk))
1298             }
1299              
1300             =head3 get_self_ip_list
1301              
1302             Returns a list of all self IP addresses on the target device.
1303              
1304             =cut
1305              
1306             sub get_self_ip_list {
1307             return @{$_[0]->_request(module => 'Networking', interface => 'SelfIP', method => 'get_list')}
1308             }
1309              
1310             =head3 get_self_ip_vlan ( $SELF_IP )
1311              
1312             Returns the VLAN associated with the specified self IP address on the target device.
1313              
1314             =cut
1315              
1316             sub get_self_ip_vlan {
1317             my ($self, $ip) = @_;
1318             return @{$self->_request(module => 'Networking', interface => 'SelfIP', method => 'get_vlan', data => { self_ips => [ $ip ] })}[0]
1319             }
1320              
1321             =head3 get_vs_list ()
1322              
1323             my @virtuals = $ic->get_vs_list();
1324              
1325             B: this method has been deprecated in future releases. Please use get_ltm_vs_list instead.
1326              
1327             Returns an array of all defined LTM virtual servers.
1328              
1329             =cut
1330              
1331             sub get_vs_list {
1332             return $_[0]->get_ltm_vs_list()
1333             }
1334              
1335             =head3 get_ltm_vs_list ()
1336              
1337             my @ltm_virtuals = $ic->get_ltm_vs_list();
1338              
1339             Returns an array of all defined LTM virtual servers.
1340              
1341             =cut
1342              
1343             sub get_ltm_vs_list {
1344             return @{$_[0]->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_list')};
1345             }
1346              
1347             =head3 get_gtm_vs_list ()
1348              
1349             my @gtm_virtuals = $ic->get_gtm_vs_list();
1350              
1351             Returns an array of the names of all defined GTM virtual servers.
1352              
1353             =cut
1354              
1355             sub get_gtm_vs_list {
1356             my @members;
1357             foreach (@{$_[0]->_request(module => 'GlobalLB', interface => 'VirtualServer', method => 'get_list')}) {
1358             push @members, $_->{name}
1359             }
1360             return @members
1361             }
1362              
1363              
1364             =head3 get_vs_destination ($virtual_server)
1365              
1366             my $destination = $ic->get_vs_destination($vs);
1367              
1368             Returns the destination of the specified virtual server in the form ipv4_address%route_domain:port.
1369              
1370             =cut
1371              
1372             sub get_vs_destination {
1373             my ($self, $vs) = @_;
1374             my $destination = @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_destination', data => {virtual_servers => [$vs]})}[0];
1375             return $destination->{address}.':'.$destination->{port}
1376             }
1377              
1378             =head3 get_vs_enabled_state ($virtual_server)
1379              
1380             print "LTM Virtual server $vs is in state ",$ic->get_vs_enabled_state($vs),"\n";
1381              
1382             B: this method has been deprecated in future releases. Please use the B instead.
1383              
1384             Return the enabled state of the specified LTM virtual server.
1385              
1386             =cut
1387              
1388             sub get_vs_enabled_state {
1389             my ($self, $vs) = @_;
1390             return $self->get_ltm_vs_enabled_state($vs)
1391             }
1392              
1393             =head3 get_ltm_vs_enabled_state ($virtual_server)
1394              
1395             print "LTM Virtual server $vs is in state ",$ic->get_ltm_vs_enabled_state($vs),"\n";
1396              
1397             Return the enabled state of the specified LTM virtual server.
1398              
1399             =cut
1400              
1401             sub get_ltm_vs_enabled_state {
1402             my ($self, $vs) = @_;
1403             return @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_enabled_state', data => {virtual_servers => [$vs]})}[0];
1404             }
1405              
1406             =head3 get_gtm_vs_enabled_state ($virtual_server)
1407              
1408             print "GTM Virtual server $vs is in state ",$ic->get_gtm_vs_enabled_state($vs),"\n";
1409              
1410             Return the enabled state of the specified GTM virtual server. The GTM server should be provided as a name only such as that
1411             returned from the B method.
1412              
1413             =cut
1414              
1415             sub get_gtm_vs_enabled_state {
1416             my ($self, $vs) = @_;
1417             my %def = $self->__get_gtm_vs_definition($vs);
1418             return @{$self->_request(module => 'GlobalLB', interface => 'VirtualServer', method => 'get_enabled_state', data => {virtual_servers => [{%def}]})}[0];
1419             }
1420              
1421             =head3 get_vs_all_statistics ()
1422              
1423             B: This method has been deprecated in future releases. Please use B.
1424              
1425             Returns the traffic statistics for all configured LTM virtual servers. The statistics are returned as
1426             VirtualServerStatistics struct hence this method is useful where access to raw statistical data is required.
1427              
1428             For parsed statistic data, see B.
1429              
1430             For specific information regarding data and units of measurement for statistics methods, please see the B section.
1431              
1432             =cut
1433              
1434             sub get_vs_all_statistics {
1435             return $_[0]->get_ltm_vs_all_statistics()
1436             #return $self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_all_statistics');
1437             }
1438              
1439             =head3 get_ltm_vs_all_statistics ()
1440              
1441             Returns the traffic statistics for all configured LTM virtual servers. The statistics are returned as
1442             VirtualServerStatistics struct hence this method is useful where access to raw statistical data is required.
1443              
1444             For parsed statistic data, see B.
1445              
1446             For specific information regarding data and units of measurement for statistics methods, please see the B section.
1447              
1448             =cut
1449              
1450             sub get_ltm_vs_all_statistics {
1451             return $_[0]->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_all_statistics');
1452             }
1453              
1454             =head3 get_vs_statistics ($virtual_server)
1455              
1456             my $statistics = $ic->get_vs_statistics($vs);
1457              
1458             Returns all statistics for the specified virtual server as a VirtualServerStatistics object. Consider using get_vs_statistics_stringified
1459             for accessing virtual server statistics in a pre-parsed hash structure.
1460              
1461             For specific information regarding data and units of measurement for statistics methods, please see the B section.
1462              
1463             =cut
1464              
1465             sub get_vs_statistics {
1466             my ($self, $vs) = @_;
1467             return $self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_statistics', data => {virtual_servers => [$vs]});
1468             }
1469              
1470             =head3 get_vs_statistics_stringified ($virtual_server)
1471              
1472             my $statistics = $ic->get_vs_statistics_stringified($vs);
1473              
1474             foreach (sort keys %{$stats{stats}}) {
1475             print "$_: $stats{stats}{$_}\n";
1476             }
1477              
1478             Returns all statistics for the specified virtual server as a multidimensional hash (hash of hashes). The hash has the following structure:
1479              
1480             {
1481             timestamp => 'yyyy-mm-dd-hh-mm-ss',
1482             stats => {
1483             statistic_1 => value,
1484             statistic_2 => value,
1485             ...
1486             statistic_n => value
1487             }
1488             }
1489              
1490             This function accepts a single parameter; the virtual server for which the statistics are to be returned.
1491              
1492             For specific information regarding data and units of measurement for statistics methods, please see the B section.
1493              
1494             =cut
1495              
1496             sub get_vs_statistics_stringified {
1497             my ($self, $vs) = @_;
1498             return __process_statistics($self->get_vs_statistics($vs));
1499             }
1500              
1501             =head3 get_ltm_vs_rules ($virtual_server)
1502              
1503             =cut
1504              
1505             sub get_ltm_vs_rules {
1506             my ($self, $vs) = @_;
1507             return map { $_->[1] }
1508             sort { $a->[0] <=> $b->[0] }
1509             map { [ $_->{priority}, $_->{rule_name} ] }
1510             @{@{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_rule', data => {virtual_servers => [$vs]})}[0]}
1511             }
1512              
1513             =head3 get_ltm_snat_pool ($virtual_server)
1514              
1515             =cut
1516              
1517             sub get_ltm_snat_pool {
1518             my($self, $vs) = @_;
1519             return @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_snat_pool', data => {virtual_servers => [$vs]})}[0]
1520             }
1521              
1522             =head3 get_ltm_snat_type ($virtual_server)
1523              
1524             =cut
1525              
1526             sub get_ltm_snat_type {
1527             my($self, $vs) = @_;
1528             return @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_snat_type', data => {virtual_servers => [$vs]})}[0]
1529             }
1530              
1531             =head3 get_default_pool_name ($virtual_server)
1532              
1533             print "Virtual Server: $virtual_server\nDefault Pool: ",
1534             $ic->get_default_pool_name($virtual_server), "\n";
1535              
1536             Returns the default pool names for the specified virtual server.
1537              
1538             =cut
1539              
1540             sub get_default_pool_name {
1541             my ($self, $vs)=@_;
1542             return @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_default_pool_name', data => {virtual_servers => [$vs]})}[0]
1543             }
1544              
1545             =head3 get_pool_list ()
1546              
1547             print join " ", ($ic->get_pool_list());
1548              
1549             Returns a list of all LTM pools in the target system.
1550              
1551             Note that this method has been deprecated in future releases - please use B instead.
1552              
1553             =cut
1554              
1555             sub get_pool_list {
1556             return $_[0]->get_ltm_pool_list()
1557             #return @{$_[0]->_request(module => 'LocalLB', interface => 'Pool', method => 'get_list')};
1558             }
1559              
1560             =head3 get_ltm_pool_list ()
1561              
1562             print join " ", ($ic->get_ltm_pool_list());
1563              
1564             Returns a list of all LTM pools in the target system.
1565              
1566             =cut
1567              
1568             sub get_ltm_pool_list {
1569             return @{$_[0]->_request(module => 'LocalLB', interface => 'Pool', method => 'get_list')};
1570             }
1571              
1572              
1573             =head3 get_pool_members ($pool)
1574              
1575             foreach my $pool ($ic->get_pool_list()) {
1576             print "\n\n$pool:\n";
1577              
1578             foreach my $member ($ic->get_pool_members($pool)) {
1579             print "\t$member\n";
1580             }
1581             }
1582              
1583             B: this method has been deprecated in future releases. Please use the B method instead.
1584              
1585             Returns a list of the pool members for the specified LTM pool. This method takes one mandatory parameter; the name of the pool.
1586              
1587             Pool member are returned in the format B.
1588              
1589             =cut
1590              
1591             sub get_pool_members {
1592             my ($self, $pool)=@_;
1593             return $self->get_ltm_pool_members($pool)
1594             #my ($self, $pool)= @_;
1595             #my @members;
1596             #foreach (@{@{$self->__get_pool_members($pool,$module)}[0]}) {push @members, ($_->{address}.':'.$_->{port})}
1597             #return @members;
1598             }
1599              
1600             =head3 get_ltm_pool_members ($pool)
1601              
1602             foreach my $pool ($ic->get_ltm_pool_list()) {
1603             print "\n\n$pool:\n";
1604              
1605             foreach my $member ($ic->get_ltm_pool_members($pool)) {
1606             print "\t$member\n";
1607             }
1608             }
1609              
1610             Returns a list of the pool members for the specified LTM pool. This method takes one mandatory parameter; the name of the pool.
1611              
1612             Pool member are returned in the format B.
1613              
1614             =cut
1615              
1616             sub get_ltm_pool_members {
1617             my ($self, $pool)= @_;
1618             my @members;
1619             foreach (@{@{$self->__get_pool_members($pool,'LocalLB')}[0]}) {push @members, ($_->{address}.':'.$_->{port})}
1620             return @members;
1621             }
1622              
1623             =head3 get_gtm_pool_members ($pool)
1624              
1625             Returns a list of the pool members for the specified GTM pool. This method takes one mandatory parameter; the name of the pool.
1626              
1627             Pool member are returned in the format B.
1628              
1629             =cut
1630              
1631             sub get_gtm_pool_members {
1632             my ($self,$pool)=@_;
1633             my @members;
1634             foreach (@{@{$self->__get_pool_members($pool,'GlobalLB')}[0]}) {push @members, $_->{member}->{address}.':'.$_->{member}->{port}}
1635             return @members
1636             }
1637              
1638             sub __get_pool_members {
1639             my ($self, $pool, $module)= @_;
1640             return $self->_request(module => $module, interface => 'Pool', method => 'get_member', data => {pool_names => [$pool]});
1641             }
1642              
1643             =head3 get_pool_statistics ($pool)
1644              
1645             my %stats = $ic->get_pool_statistics($pool);
1646              
1647             Returns the statistics for the specified pool as a PoolStatistics object. For pre-parsed pool statistics consider using
1648             the B method.
1649              
1650             =cut
1651              
1652             sub get_pool_statistics {
1653             my ($self, $pool)= @_;
1654             return $self->_request(module => 'LocalLB', interface => 'Pool', method => 'get_statistics', data => {pool_names => [$pool]});
1655             }
1656              
1657             =head3 get_pool_statistics_stringified ($pool)
1658              
1659             my %stats = $ic->get_pool_statistics_stringified($pool);
1660             print "Pool $pool bytes in: $stats{stat}{STATISTIC_SERVER_SIDE_BYTES_OUT}";
1661              
1662             Returns a hash containing all pool statistics for the specified pool in a delicious, easily digestable and improved formula.
1663              
1664             =cut
1665              
1666             sub get_pool_statistics_stringified {
1667             my ($self, $pool)= @_;
1668             return __process_statistics($self->get_pool_statistics($pool));
1669             }
1670              
1671             =head3 get_pool_member_statistics ($pool)
1672              
1673             Returns all pool member statistics for the specified pool as an array of MemberStatistics objects. Unless you feel like
1674             playing with Data::Dumper on a rainy Sunday afternoon, consider using B method.
1675              
1676             =cut
1677              
1678             sub get_pool_member_statistics {
1679             my ($self, $pool)= @_;
1680            
1681             return $self->_request(module => 'LocalLB', interface => 'PoolMember', method => 'get_statistics', data => {
1682             pool_names => [$pool],
1683             members => $self->__get_pool_members($pool,'LocalLB') });
1684             }
1685              
1686             =head3 get_pool_member_statistics_stringified ($pool)
1687              
1688             my %stats = $ic->get_pool_member_statistics_stringified($pool);
1689              
1690             print "Member\t\t\t\tRequests\n",'-'x5,"\t\t\t\t",'-'x5,"\n";
1691            
1692             foreach my $member (sort keys %stats) {
1693             print "$member\t\t$stats{$member}{stats}{STATISTIC_TOTAL_REQUESTS}\n";
1694             }
1695              
1696             # Prints a list of requests per pool member
1697              
1698             Returns a hash containing all pool member statistics for the specified pool. The hash has the following
1699             structure;
1700              
1701             member_1 => {
1702             timestamp => 'YYYY-MM-DD-hh-mm-ss',
1703             stats => {
1704             statistics_1 => value
1705             ...
1706             statistic_n => value
1707             }
1708             }
1709             member_2 => {
1710             ...
1711             }
1712             member_n => {
1713             ...
1714             }
1715              
1716             Each pool member is specified in the form ipv4_address%route_domain:port.
1717              
1718             =cut
1719              
1720             sub get_pool_member_statistics_stringified {
1721             my ($self, $pool)= @_;
1722             return __process_pool_member_statistics($self->get_pool_member_statistics($pool))
1723             }
1724              
1725             =head3 get_all_pool_member_statistics ($pool)
1726              
1727             Returns all pool member statistics for the specified pool. This method is analogous to the B
1728             method and the two will likely be merged in a future release.
1729              
1730             =cut
1731              
1732             sub get_all_pool_member_statistics {
1733             my ($self, $pool)= @_;
1734             return $self->_request(module => 'LocalLB', interface => 'PoolMember', method => 'get_all_statistics', data => {pool_names => [$pool]});
1735             }
1736              
1737             =head3 get_ltm_pool_status ($pool)
1738              
1739             Returns the status of the specified pool as a ObjectStatus object.
1740              
1741             For formatted pool status information, see the B method.
1742              
1743             =cut
1744              
1745             sub get_ltm_pool_status {
1746             my ($self, $pool)= @_;
1747             return @{$self->_request(module => 'LocalLB', interface => 'Pool', method => 'get_object_status', data => {pool_names => [$pool]})}[0]
1748             }
1749              
1750             =head3 get_ltm_pool_availability_status ($pool)
1751              
1752             Retuns the availability status of the specified pool.
1753              
1754             =cut
1755              
1756             sub get_ltm_pool_availability_status {
1757             my ($self, $pool)= @_;
1758             return $self->get_ltm_pool_status_as_string($pool,'availability_status');
1759             }
1760              
1761             =head3 get_ltm_pool_enabled_status ($pool)
1762              
1763             Retuns the enabled status of the specified pool.
1764              
1765             =cut
1766              
1767             sub get_ltm_pool_enabled_status {
1768             my ($self, $pool)= @_;
1769             return $self->get_ltm_pool_status_as_string($pool,'enabled_status');
1770             }
1771              
1772             =head3 get_ltm_pool_status_description ($pool)
1773              
1774             Returns a descriptive status of the specified pool.
1775              
1776             =cut
1777              
1778             sub get_ltm_pool_status_description {
1779             my ($self, $pool)= @_;
1780             return $self->get_ltm_pool_status_as_string($pool,'status_description');
1781             }
1782              
1783             =head3 get_ltm_pool_status_as_string ($pool)
1784              
1785             Returns the pool status as a descriptive string.
1786              
1787             =cut
1788              
1789             sub get_ltm_pool_status_as_string {
1790             my ($self, $pool, $status_key)= @_;
1791            
1792             $status_key or ($status_key = 'status_description');
1793            
1794             return $self->get_ltm_pool_status($pool)->{$status_key};
1795             }
1796              
1797             sub _get_ltm_pool_member_oject_status {
1798             my ($self, $pool)
1799             }
1800              
1801             =head3 get_connection_list ()
1802              
1803             Returns a list of active connections as a list of ConnectionID objects.
1804              
1805             =cut
1806              
1807             sub get_connection_list {
1808             return $_[0]->_request(module => 'System', interface => 'Connections', method => 'get_list');
1809             }
1810              
1811             =head3 get_all_active_connections ()
1812              
1813             Gets all active connections in details on the device.
1814              
1815             =cut
1816              
1817             sub get_all_active_connections {
1818             return $_[0]->_request(module => 'System', interface => 'Connections', method => 'get_all_active_connections');
1819             }
1820              
1821             =head3 get_active_connections_count()
1822              
1823             Returns the number of all active connections on the device.
1824              
1825             =cut
1826              
1827             sub get_active_connections_count {
1828             return scalar @{$_[0]->get_all_active_connections()}
1829             }
1830              
1831             =head3 get_node_list ()
1832              
1833             print join "\n", ($ic->get_node_list());
1834              
1835             Returns a list of all configured nodes in the target system.
1836              
1837             Nodes are returned as ipv4 addresses.
1838              
1839             =cut
1840              
1841             sub get_node_list {
1842             return @{$_[0]->_request(module => 'LocalLB', interface => 'NodeAddress', method => 'get_list')}
1843             }
1844              
1845             =head3 get_screen_name ($node)
1846              
1847             foreach ($ic->get_node_list()) {
1848             print "Node: $_ (" . $ic->get_screen_name($_) . ")\n";
1849             }
1850              
1851             Retuns the screen name of the specified node.
1852              
1853             =cut
1854              
1855             sub get_screen_name {
1856             my ($self, $node)= @_;
1857             return @{$self->_request(module => 'LocalLB', interface => 'NodeAddress', method => 'get_screen_name', data => {node_addresses => [$node]})}[0]
1858             }
1859              
1860             =head3 get_node_status ($node)
1861              
1862             $ic->get_node_status(
1863              
1864             Returns the status of the specified node as a ObjectStatus object.
1865              
1866             For formatted node status information, see the B method.
1867              
1868             =cut
1869              
1870             sub get_node_status {
1871             my ($self, $node)= @_;
1872             return @{$self->_request(module => 'LocalLB', interface => 'NodeAddress', method => 'get_object_status', data => {node_addresses => [$node]})}[0]
1873             }
1874              
1875             =head3 get_node_availability_status ($node)
1876              
1877             Retuns the availability status of the node.
1878              
1879             =cut
1880              
1881             sub get_node_availability_status {
1882             my ($self, $node)= @_;
1883             return $self->get_node_status_as_string($node,'availability_status');
1884             }
1885              
1886             =head3 get_node_enabled_status ($node)
1887              
1888             Retuns the enabled status of the node.
1889              
1890             =cut
1891              
1892             sub get_node_enabled_status {
1893             my ($self, $node)= @_;
1894             return $self->get_node_status_as_string($node,'enabled_status');
1895             }
1896              
1897             =head3 get_node_status_description ($node)
1898              
1899             Returns a descriptive status of the specified node.
1900              
1901             =cut
1902              
1903             sub get_node_status_description {
1904             my ($self, $node)= @_;
1905             return $self->get_node_status_as_string($node,'status_description');
1906             }
1907              
1908             =head3 get_node_status_as_string ($node)
1909              
1910             Returns the node status as a descriptive string.
1911              
1912             =cut
1913              
1914             sub get_node_status_as_string {
1915             my ($self, $node, $status_key)= @_;
1916            
1917             $status_key or ($status_key = 'status_description');
1918            
1919             return $self->get_node_status($node)->{$status_key};
1920             }
1921              
1922             =head3 get_node_monitor_status ($node)
1923              
1924             Gets the current availability status of the specified node addresses.
1925              
1926             =cut
1927              
1928             sub get_node_monitor_status {
1929             my ($self, $node)= @_;
1930             return @{$self->_request(module => 'LocalLB', interface => 'NodeAddress', method => 'get_monitor_status', data => {node_addresses => [$node]})}[0];
1931             }
1932              
1933             =head3 get_node_statistics ($node)
1934              
1935             Returns all statistics for the specified node.
1936              
1937             =cut
1938              
1939             sub get_node_statistics {
1940             my ($self, $node)= @_;
1941             return $self->_request(module =>'LocalLB', interface => 'NodeAddress', method => 'get_statistics', data => {node_addresses => [$node]})
1942             }
1943              
1944             =head3 get_node_statistics_stringified
1945              
1946             my %stats = $ltm->get_node_statistics_stringified($node);
1947              
1948             foreach (sort keys %{stats{stats}}) {
1949             print "$_:\t$stats{stats}{$_}{high}\t$stats{stats}{$_}{low}\n";
1950             }
1951              
1952             Returns a multidimensional hash containing all current statistics for the specified node. The hash has the following structure:
1953              
1954             {
1955             timestamp => 'yyyy-mm-dd-hh-mm-ss',
1956             stats => {
1957             statistic_1 => value,
1958             statistic_2 => value,
1959             ...
1960             statistic_n => value
1961             }
1962             }
1963              
1964             This function accepts a single parameter; the node for which the statistics are to be returned.
1965              
1966             For specific information regarding data and units of measurement for statistics methods, please see the B section.
1967              
1968             =cut
1969              
1970             sub get_node_statistics_stringified {
1971             my ($self, $node)= @_;
1972             return __process_statistics($self->get_node_statistics($node));
1973             }
1974              
1975             =head3 get_gtm_pool_list ()
1976              
1977             Returns a list of GTM pools.
1978              
1979             =cut
1980              
1981             sub get_gtm_pool_list {
1982             return @{$_[0]->_request(module => 'GlobalLB', interface => 'Pool', method => 'get_list')}
1983             }
1984              
1985             =head3 get_gtm_pool_description ()
1986              
1987             Returns a description of the specified GTM pool.
1988              
1989             =cut
1990              
1991             sub get_gtm_pool_description {
1992             my ($self, $pool)=@_;
1993             return @{$self->_request(module => 'GlobalLB', interface => 'Pool', method => 'get_description', data => {pool_names => [$pool]})}[0];
1994             }
1995              
1996             =head3 get_gtm_vs_all_statistics ()
1997              
1998             Returns the traffic statistics for all configured GTM virtual servers. The statistics are returned as
1999             VirtualServerStatistics struct hence this method is useful where access to raw statistical data is required.
2000              
2001             For parsed statistic data, see B.
2002              
2003             For specific information regarding data and units of measurement for statistics methods, please see the B section.
2004              
2005             =cut
2006              
2007             sub get_gtm_vs_all_statistics {
2008             return $_[0]->_request(module => 'GlobalLB', interface => 'VirtualServer', method => 'get_all_statistics');
2009             }
2010              
2011             sub __get_gtm_vs_definition {
2012             my ($self, $vs)=@_;
2013             foreach (@{$self->_request(module => 'GlobalLB', interface => 'VirtualServer', method => 'get_list')}) {
2014             return %{$_} if ($_->{name} eq $vs)
2015             }
2016             }
2017              
2018             =head3 get_ltm_address_class_list ()
2019              
2020             Returns a list of all existing address classes.
2021              
2022             =cut
2023              
2024             sub get_ltm_address_class_list {
2025             return @{ $_[0]->_request(module => 'LocalLB', interface => 'Class', method => 'get_address_class_list') }
2026             }
2027              
2028             =head3 get_ltm_string_class_list ()
2029              
2030             Returns a list of all existing string classes.
2031              
2032             =cut
2033              
2034             sub get_ltm_string_class_list {
2035             return @{ $_[0]->_request(module => 'LocalLB', interface => 'Class', method => 'get_string_class_list') }
2036             }
2037              
2038             =head3 get_ltm_string_class ( $class_name )
2039              
2040             Return the specified LTM string class.
2041              
2042             =cut
2043              
2044             sub get_ltm_string_class {
2045             my ( $self, $class ) = @_;
2046             return @{ $self->_request(module => 'LocalLB', interface => 'Class', method => 'get_string_class', data => { class_names => [ $class ] } ) }[0]->{members}
2047             }
2048              
2049             =head3 get_ltm_string_class_members ( $class )
2050              
2051             Returns the specified LTM string class members.
2052              
2053             =cut
2054              
2055             sub get_ltm_string_class_members {
2056             my ( $self, $class ) = @_;
2057             return $self->_request( module => 'LocalLB', interface => 'Class', method => 'get_string_class_member_data_value', data => { class_members =>
2058             [ @{ $self->_request(module => 'LocalLB', interface => 'Class', method => 'get_string_class', data => { class_names => [ $class ] } ) }[0] ] } )
2059             }
2060              
2061             =head3 add_ltm_string_class_member ( $class, $member )
2062              
2063             Add the provided member to the specified class.
2064              
2065             =cut
2066              
2067             sub add_ltm_string_class_member {
2068             my ( $self, $class, $member ) = @_;
2069             $self->_request( module => 'LocalLB',
2070             interface => 'Class',
2071             method => 'add_string_class_member',
2072             data => {
2073             class_members => [
2074             {
2075             name => $class,
2076             members => [ $member ]
2077             }
2078             ]
2079             }
2080             )
2081             }
2082              
2083             =head3 delete_ltm_string_class_member ( $class, $member )
2084              
2085             Deletes the provided member from the specified class.
2086              
2087             =cut
2088              
2089             sub delete_ltm_string_class_member {
2090             my ( $self, $class, $member ) = @_;
2091             $self->_request( module => 'LocalLB',
2092             interface => 'Class',
2093             method => 'delete_string_class_member',
2094             data => {
2095             class_members => [
2096             {
2097             name => $class,
2098             members => [ $member ]
2099             }
2100             ]
2101             }
2102             )
2103             }
2104              
2105             =head3 set_ltm_string_class_member ( $class, $member, value )
2106              
2107             Sets the value of the member to the provided value in the specified class.
2108              
2109             =cut
2110              
2111             sub set_ltm_string_class_member {
2112             my ( $self, $class, $member, $value ) = @_;
2113             $self->_request( module => 'LocalLB',
2114             interface => 'Class',
2115             method => 'set_string_class_member_data_value',
2116             data => {
2117             class_members => [
2118             {
2119             name => $class,
2120             members => [ $member ]
2121             }
2122             ],
2123             values => [
2124             [ $value ]
2125             ]
2126             }
2127             )
2128             }
2129              
2130             =head3 get_db_variable ( $VARIABLE )
2131              
2132             # Prints the value of the configsync.state database variable.
2133             print "Config state is " . $ic->get_db_variable('configsync.state') . "\n";
2134              
2135             Returns the value of the specified db variable.
2136              
2137             =cut
2138              
2139             sub get_db_variable {
2140             my ($self,$var) = @_;
2141             return @{$self->_request(module => 'Management', interface => 'DBVariable', method => 'query', data => { variables => [$var] })}[0]->{value}
2142             }
2143              
2144             =head3 get_event_subscription_list
2145              
2146             Returns an array of event subscription IDs for all registered event subscriptions.
2147              
2148             =cut
2149              
2150             sub get_event_subscription_list {
2151             my ($self, %args)=@_;
2152             return $self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_list');
2153             }
2154              
2155             =head3 get_event_subscription
2156              
2157             =cut
2158              
2159             sub get_event_subscription {
2160             my ($self, $id)=@_;
2161             return $self->_request(module => 'Management', interface => 'EventSubscription', method => 'query', data => { id_list => [$id] })
2162             }
2163              
2164             =head3 remove_event_subscription
2165              
2166             =cut
2167              
2168             sub remove_event_subscription {
2169             my ($self, $id)=@_;
2170             return $self->_request(module => 'Management', interface => 'EventSubscription', method => 'remove', data => { id_list => [$id] })
2171             }
2172              
2173             =head3 get_event_subscription_state
2174              
2175             =cut
2176              
2177             sub _get_event_subscription_state {
2178             my ($self,$id) = @_;
2179             return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_state', data => { id_list => [$id] })}[0]
2180             }
2181              
2182             =head3 get_event_subscription_url
2183              
2184             =cut
2185              
2186             sub get_event_subscription_url {
2187             my ($self,$id) = @_;
2188             return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_url', data => { id_list => [$id] })}[0]
2189             }
2190              
2191             sub _get_event_subscription_proxy_url {
2192             my ($self,$id) = @_;
2193             return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_proxy_url', data => { id_list => [$id] })}[0]
2194             }
2195              
2196             sub _get_event_subscription_authentication {
2197             my ($self,$id) = @_;
2198             return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_proxy_url', data => { id_list => [$id] })}[0]
2199             }
2200              
2201             sub get_subscription_list {
2202             my $self = shift;
2203             my @subs;
2204             foreach (@{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_list')}){push @subs, $_}
2205             return @subs
2206             }
2207              
2208             =head3 get_subscription_list
2209              
2210             This method is an analog of B
2211              
2212             =cut
2213              
2214             =head3 create_subscription_list (%args)
2215              
2216             my $subscription = $ic->create_subscription_list (
2217             name => 'my_subscription_name',
2218             url => 'http://company.com/my/eventnotification/endpoint,
2219             username => 'username',
2220             password => 'password',
2221             ttl => -1,
2222             min_events_per_timeslice => 10,
2223             max_timeslice => 10
2224             );
2225              
2226             Creates an event subscription with the target system. This method requires the following parameters:
2227              
2228             =over 3
2229              
2230             =item name
2231              
2232             A user-friendly name for the subscription.
2233              
2234             =item url
2235              
2236             The target URL endpoint for the event notification interface to send event notifications.
2237              
2238             =item username
2239              
2240             The basic authentication username required to access the URL endpoint.
2241              
2242             =item password
2243              
2244             The basic authentication password required to access the URL endpoint.
2245              
2246             =item ttl
2247              
2248             The time to live (in seconds) for this subscription. After the ttl is reached, the subscription
2249             will be removed from the system. A value of -1 indicates an infinite life time.
2250              
2251             =item min_events_per_timeslice
2252              
2253             The minimum number of events needed to trigger a notification. If this value is 50, then this
2254             means that when 50 events are queued up they will be sent to the notification endpoint no matter
2255             what the max_timeslice is set to.
2256              
2257             =item max_timeslice
2258              
2259             This maximum time to wait (in seconds) before event notifications are sent to the notification
2260             endpoint. If this value is 30, then after 30 seconds a notification will be sent with the events
2261             in the subscription queue.
2262              
2263             =back
2264              
2265             =cut
2266              
2267             sub create_subscription_list {
2268             my ($self, %args)=@_;
2269             $args{name} or return 'Request error: missing "name" parameter';
2270             $args{url} or return 'Request error: missing "url" parameter';
2271             #$args{username} or return 'Request error: missing "username" parameter';
2272             #$args{password} or return 'Request error: missing "password" parameter';
2273             $args{ttl} =~ /^(-)?\d+$/ or return 'Request error: missing or incorrect "ttl" parameter';
2274             $args{min_events_per_timeslice} =~ /^(-)?\d+$/ or return 'Request error: missing or incorrect "min_events_per_timeslice" parameter';
2275             $args{max_timeslice} =~ /^(-)?\d+$/ or return 'Request error: missing or incorrect "max_timeslice" parameter';
2276             @{$args{event_type}} > 0 or return 'Request error: missing "event_type" parameter';
2277              
2278             foreach my $event (@{$args{event_type}}) {
2279             exists $event_types->{$event} or return "Request error: unknown \"event_type\" parameter \"$event\"";
2280             }
2281              
2282             my $sub_detail_list= {
2283             name => $args{name},
2284             event_type_list => [@{$args{event_type}}],
2285             url => $args{url},
2286             url_credentials => {
2287             auth_mode => 'AUTHMODE_NONE',
2288             #username => $args{username},
2289             #password => $args{password}
2290             },
2291             ttl => $args{ttl},
2292             min_events_per_timeslice => $args{min_events_per_timeslice},
2293             max_timeslice => $args{max_timeslice},
2294             enabled_state => 'STATE_ENABLED'
2295             };
2296             return $self->_request(module => 'Management', interface => 'EventSubscription', method => 'create', data => {sub_detail_list => [$sub_detail_list]});
2297             }
2298              
2299             =head1 NOTES
2300              
2301             =head3 Statistic Methods
2302              
2303             Within iControl, statistical values are a 64-bit unsigned integer represented as a B object.
2304             The ULong64 object is a stuct of two 32-bit values. This representation is used as there is no native
2305             support for the encoding of 64-bit numbers in SOAP.
2306              
2307             The ULong object has the following structure;
2308              
2309             ({
2310             STATISTIC_NAME => {
2311             high => long
2312             low => long
2313             }
2314             }, bless Common::ULong64)
2315              
2316             Where high is the unsigned 32-bit integer value of the high-order portion of the measured value and low is
2317             the unsigned 32-bit integer value of the low-order portion of the measured value.
2318              
2319             In non-stringified statistic methods, these return values are ULong64 objects as returned by the iControl API.
2320             In stringified statistic method calls, the values are processed on the client side into a local 64-bit representation
2321             of the value using the following form.
2322              
2323             $value = ($high<<32)|$low;
2324              
2325             Stringified method calls are guaranteed to return a correct localised 64-bit representation of the value.
2326              
2327             It is the callers responsibility to convert the ULong struct for all other non-stringified statistic method calls.
2328              
2329             =head1 AUTHOR
2330              
2331             Luke Poskitt, Eltp@cpan.orgE
2332              
2333             Thanks to Eric Welch, Eerik.welch@gmail.comE, for input and feedback.
2334              
2335             =head1 LICENSE AND COPYRIGHT
2336              
2337             This program is free software; you can redistribute it and/or modify it
2338             under the terms of either: the GNU General Public License as published
2339             by the Free Software Foundation; or the Artistic License.
2340              
2341             See http://dev.perl.org/licenses/ for more information.
2342              
2343             =cut
2344              
2345             1;