Perl GTM Pool

Problem this snippet solves:

Here's a little sample perl script that illustrates how to get and set the enabled state of a GTM Pool.

Code :

#!/usr/bin/perl
#----------------------------------------------------------------------------
# The contents of this file are subject to the "END USER LICENSE AGREEMENT FOR F5
# Software Development Kit for iControl"; you may not use this file except in
# compliance with the License. The License is included in the iControl
# Software Development Kit.
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is iControl Code and related documentation
# distributed by F5.
#
# The Initial Developer of the Original Code is F5 Networks,
# Inc. Seattle, WA, USA. Portions created by F5 are Copyright (C) 1996-2004 F5 Networks,
# Inc. All Rights Reserved.  iControl (TM) is a registered trademark of F5 Networks, Inc.
#
# Alternatively, the contents of this file may be used under the terms
# of the GNU General Public License (the "GPL"), in which case the
# provisions of GPL are applicable instead of those above.  If you wish
# to allow use of your version of this file only under the terms of the
# GPL and not to allow others to use your version of this file under the
# License, indicate your decision by deleting the provisions above and
# replace them with the notice and other provisions required by the GPL.
# If you do not delete the provisions above, a recipient may use your
# version of this file under either the License or the GPL.
#----------------------------------------------------------------------------

#use SOAP::Lite + trace => qw(method debug);
use SOAP::Lite;
use MIME::Base64;
use Math::BigInt;

BEGIN { push (@INC, ".."); }
use iControlTypeCast;

#----------------------------------------------------------------------------
# Validate Arguments
#----------------------------------------------------------------------------
my $sHost = $ARGV[0];
my $sPort = $ARGV[1];
my $sUID = $ARGV[2];
my $sPWD = $ARGV[3];
my $sPool = $ARGV[4];
my $sEnable = $ARGV[5];
my $sProtocol = "https";


if ( ("80" eq $sPort) or ("8080" eq $sPort) )
{
  $sProtocol = "http";
}

if ( ($sHost eq "") or ($sPort eq "") or ($sUID eq "") or ($sPWD eq "") )
{
  &usage();
}

sub usage()
{
  my ($sCmd) = @_;
  print "Usage: GlobalLBPool.pl host port uid pwd pool [enable|disable]\n";
  exit();
}

#----------------------------------------------------------------------------
# Transport Information
#----------------------------------------------------------------------------
sub SOAP::Transport::HTTP::Client::get_basic_credentials-->
{
  return "$sUID" => "$sPWD";
}

$Pool = SOAP::Lite
  -> uri('urn
  -> proxy("$sProtocol://$sHost:$sPort/iControl/iControlPortal.cgi");
eval { $Pool->transport->http_request->header
(
  'Authorization' => 
    'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')-->
); };

if ( $sPool eq "" )
{
  &GetPoolList();
}
else
{
  if ( $sEnable eq "" )
  {
    &GetPoolState($sPool);
  }
  else
  {
    &SetPoolState($sPool, $sEnable);
  }
}

sub GetPoolList()
{
  $soapResponse = $Pool->get_list();
  &checkResponse($soapResponse);
  @pools = @{$soapResponse->result};
  foreach $pool (@pools)
  {
    print "$pool\n";
  }
}

#----------------------------------------------------------------------------
# GetPoolState
#----------------------------------------------------------------------------
sub GetPoolState()
{
  my ($pool) = (@_);
  $soapResponse = $Pool->get_enabled_state(
    SOAP::Data->name(pool_names => [$pool])
  );
  &checkResponse($soapResponse);
  @states = @{$soapResponse->result};
  foreach $state (@states)
  {
    print "$state\n";
  }
  
}

sub SetPoolState()
{
  my($pool, $state) = (@_);
  
  print " Setting pool '$pool' to state '$state'\n";
  
  if ( $state eq "enabled" )
  {
    $state = "STATE_ENABLED";
  }
  else
  {
    $state = "STATE_DISABLED";
  }
  
  my @gtmPools;
  push @gtmPools, $pool;
#  push @gtmPools, "gtm_pool_2";
  
  my @gtmEnabled;
  push @gtmEnabled, $state;
#  push @gtmEnabled, $state;
  
  $soapResponse = $Pool->set_enabled_state(
    SOAP::Data->name(pool_names => [@gtmPools]),
    SOAP::Data->name(states => [@gtmEnabled])
  );
  &checkResponse($soapResponse);
  &GetPoolState($pool);
}

#----------------------------------------------------------------------------
# checkResponse
#----------------------------------------------------------------------------
sub checkResponse()
{
  my ($soapResponse) = (@_);
  if ( $soapResponse->fault )
  {
    print $soapResponse->faultcode, " ", $soapResponse->faultstring, "\n";
    exit();
  }
}