Perl Gtm Pool Member

Problem this snippet solves:

This perl sample will allow you to query a wideip's pool members and set their enabled state.

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 HTTP::Cookies;

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

#----------------------------------------------------------------------------
# Validate Arguments
#----------------------------------------------------------------------------
my $sHost = $ARGV[0];
my $sUID = $ARGV[1];
my $sPWD = $ARGV[2];
my $sWideIP = $ARGV[3];
my $sPool = $ARGV[4];
my $sPoolMember = $ARGV[5];
my $sState = $ARGV[6];

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

sub usage()
{
  die ("Usage: GTMPoolMember.pl host uid pwd [wideip [pool [member [enable|disable]]]]\n");
}

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

$GlobalLBPool = SOAP::Lite
  -> uri('urn:iControl:GlobalLB/Pool')
  -> proxy("https://$sHost/iControl/iControlPortal.cgi",
    cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
eval { $GlobalLBPool->transport->http_request->header
(
  'Authorization' => 
    'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')
); };

$GlobalLBPoolMember = SOAP::Lite
  -> uri('urn:iControl:GlobalLB/PoolMember')
  -> proxy("https://$sHost/iControl/iControlPortal.cgi",
    cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
eval { $GlobalLBPoolMember->transport->http_request->header
(
  'Authorization' => 
    'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')
); };

$GlobalLBWideIP = SOAP::Lite
  -> uri('urn:iControl:GlobalLB/WideIP')
  -> proxy("https://$sHost/iControl/iControlPortal.cgi",
    cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
eval { $GlobalLBWideIP->transport->http_request->header
(
  'Authorization' => 
    'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')
); };

#----------------------------------------------------------------------------
# sub getWideIPList
#----------------------------------------------------------------------------
sub getWideIPList()
{
  $soapResponse = $GlobalLBWideIP->get_list();
  &checkResponse($soapResponse);
  @wideipList = @{$soapResponse->result};
  
  print "WideIP's\n";
  print "=============\n";
  foreach $wideip (@wideipList)
  {
    print "$wideip\n";
  }
}

#----------------------------------------------------------------------------
# sub getWideIPPoolList
#----------------------------------------------------------------------------
sub getWideIPPoolList()
{
  my ($wideIP) = @_;
  
  print "getting pools for wideip: $wideIP\n";
  
  $soapResponse = $GlobalLBWideIP->get_wideip_pool(
    SOAP::Data->name(wide_ips => [$wideIP])
  );
  &checkResponse($soapResponse);
  @WideIPPoolAofA = @{$soapResponse->result};
  
  print "Wideip: $wideIP\n";
  @WideIPPoolA = @{@WideIPPoolAofA[0]};
  foreach $WideIPPool (@WideIPPoolA)
  {
    $pool_name = $WideIPPool->{"pool_name"};
    $order = $WideIPPool->{"order"};
    $ratio = $WideIPPool->{"ratio"};
    
    print "  Pool $pool_name; order $order; ratio: $ratio\n";
  }
}

#----------------------------------------------------------------------------
# sub getWideIPPoolMemberList
#----------------------------------------------------------------------------
sub getWideIPPoolMemberList()
{
  my ($wideIP, $pool) = (@_);
  
  print "Retriving pool members for wideip pool ${wideIP}:${pool}\n";
  
  $soapResponse = $GlobalLBPool->get_member(
    SOAP::Data->name(pool_names => [$pool])
  );
  &checkResponse($soapResponse);
  @PoolMemberDefinitionAofA = @{$soapResponse->result};
  
  print "WideIP: $wideIP\n";
  print "Pool  : $pool\n";
  @PoolMemberDefinitionA = @{@PoolMemberDefinitionAofA[0]};
  foreach $PoolMemberDefinition (@PoolMemberDefinitionA)
  {
    $member = $PoolMemberDefinition->{"member"};
    $address = $member->{"address"};
    $port = $member->{"port"};
    $order = $PoolMemberDefinition->{"order"};
    
    print "  MEMBER: ${address}:${port}; order ${order}\n";
  }
}

#----------------------------------------------------------------------------
# sub getWideIPPoolMemberState
#----------------------------------------------------------------------------
sub getWideIPPoolMemberState()
{
  my ($wideIP, $pool, $memberdef) = (@_);
  
  ($addr, $port) = split(/:/, $memberdef, 2);
  
  $IPPortDefinition = {
    address => $addr,
    port => $port
  };
  
  my @membersA;
  push @membersA, $IPPortDefinition;
  
  my @membersAofA;
  push @membersAofA, [@membersA];
  
  $soapResponse = $GlobalLBPoolMember->get_enabled_state(
    SOAP::Data->name(pool_names => [$pool]),
    SOAP::Data->name(members => [@membersAofA])
  );
  &checkResponse($soapResponse);
  
  @memberEnabledStateAofA = @{$soapResponse->result};
  
  @memberEnabledStateA = @{@memberEnabledStateAofA[0]};
  $memberEnabledState = @memberEnabledStateA[0];
  
  $member = $memberEnabledState->{"member"};
  $state = $memberEnabledState->{"state"};
  
  print "WIDEIP : $wideIP\n";
  print "POOL   : $pool\n";
  print "Member : $memberdef\n";
  print "State  : $state\n";
}

#----------------------------------------------------------------------------
# sub setWideIPPoolMemberState
#----------------------------------------------------------------------------
sub setWideIPPoolMemberState()
{
  my ($wideIP, $pool, $memberdef, $state) = (@_);
  
  ($addr, $port) = split(/:/, $memberdef, 2);
  
  $IPPortDefinition = {
    address => $addr,
    port => $port
  };
  
  if ( ($state eq "STATE_DISABLED") or ($state eq "STATE_ENABLED") )
  {
  }
  elsif ( ($state eq "enable") or ($state eq "enabled") )
  {
    $state = "STATE_ENABLED";
  }
  elsif ( ($state eq "disable") or ($state eq "disabled") )
  {
    $state = "STATE_DISABLED";
  }
  else
  {
    &usage();
  }
  
  
  $memberEnabledState = {
    member => $IPPortDefinition,
    state => $state
  };
  
  my @memberEnabledStateA;
  push @memberEnabledStateA, $memberEnabledState;
  
  my @memberEnabledStateAofA;
  push @memberEnabledStateAofA, [@memberEnabledStateA];
  
  
  $soapResponse = $GlobalLBPoolMember->set_enabled_state(
    SOAP::Data->name(pool_names => [$pool]),
    SOAP::Data->name(states => [@memberEnabledStateAofA])
  );
  &checkResponse($soapResponse);
  
  print "Pool Member State Updated\n";
  print "${wideIP}:${pool}:${memberdef} -> ${state}\n";
}

if ( "" eq $sWideIP )
{
  # get wideip list
  &getWideIPList();
  
}
elsif ( "" eq $sPool )
{
  # get wideip pool list
  &getWideIPPoolList($sWideIP);
}
elsif ( "" eq $sPoolMember )
{
  # get pool member list
  &getWideIPPoolMemberList($sWideIP, $sPool);
}
elsif ( "" eq $sState )
{
  # Get pool member state
  &getWideIPPoolMemberState($sWideIP, $sPool, $sPoolMember);
}
else
{
  # Toggle specified pool member
  &setWideIPPoolMemberState($sWideIP, $sPool, $sPoolMember, $sState);
  &getWideIPPoolMemberState($sWideIP, $sPool, $sPoolMember);
}


#----------------------------------------------------------------------------
# checkResponse makes sure the error isn't a SOAP error
#----------------------------------------------------------------------------
sub checkResponse()
{
  my ($soapResponse) = (@_);
  if ( $soapResponse->fault )
  {
    print $soapResponse->faultcode, " ", $soapResponse->faultstring, "\n";
    exit();
  }
}