PerlVipFromPool

Problem this snippet solves:

This sample will take as input a pool name and then do a reverse lookup to determine the list of virtual servers using it. It will then print out the virtual servers destination ip and port along with the virtual server name.

Code :

#!/usr/bin/perl
#----------------------------------------------------------------------------
# The contents of this file are subject to the iControl Public License
# Version 9.2 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.f5.com/.
#
# 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-2005
# 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;

#----------------------------------------------------------------------------
# Validate Arguments
#----------------------------------------------------------------------------
my $sHost = $ARGV[0];
my $sUID = $ARGV[1];
my $sPWD = $ARGV[2];
my $sPool = $ARGV[3];

sub Usage()
{
print "Usage: VipFromPool.pl host uid pwd [poolname]\n";
  exit;
}

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

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


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

#----------------------------------------------------------------------------
# GetInterface
#----------------------------------------------------------------------------
sub GetInterface()
{
  my ($name) = (@_);
  my $Interface = SOAP::Lite
    -> uri("urn:iControl:$name")
    -> readable(1)
    -> proxy("https://$sHost/iControl/iControlPortal.cgi");
    
  #----------------------------------------------------------------------------
  # Attempt to add auth headers to avoid dual-round trip
  #----------------------------------------------------------------------------
  eval { $Interface->transport->http_request->header
  (
    'Authorization' => 'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')
  ); };
  
  return $Interface;
}

$Pool = &GetInterface("LocalLB/Pool");
$VirtualServer = &GetInterface("LocalLB/VirtualServer");

#----------------------------------------------------------------------------
# GetPoolList
#----------------------------------------------------------------------------
sub GetPoolList()
{
  $soapResponse = $Pool->get_list();
  &checkResponse($soapResponse);
  @pool_list = @{$soapResponse->result};
  
  return @pool_list;
}

#----------------------------------------------------------------------------
# GetVipsFromPool
#----------------------------------------------------------------------------
sub GetVipsFromPool()
{
  my @pools = (@_);
  
  $soapResponse = $VirtualServer->get_list();
  &checkResponse($soapResponse);
  @vs_list = @{$soapResponse->result};
  
  $soapResponse = $VirtualServer->get_destination(
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @dest_list = @{$soapResponse->result};
  
  $soapResponse = $VirtualServer->get_default_pool_name(
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @pool_list = @{$soapResponse->result};

  foreach $pool (@pools)
  {
    print "Virtual Servers for pool '$pool'\n";
    print "------------------------------\n";
    $found = 0;
    for $i (0 .. $#vs_list)
    {
      $vs = @vs_list[$i];
      $dest = @dest_list[$i];
      $addr = $dest->{"address"};
      $port = $dest->{"port"};
      $p2 = @pool_list[$i];
      if ( $p2 eq $pool )
      {
        print "  ${addr}:${port} ($vs)\n";
        $found = 1;
      }
    }
    if ( $found == 0 )
    {
      print "  NONE FOUND\n";
    }
    print "\n";
  }
}

#----------------------------------------------------------------------------
# Main logic
#----------------------------------------------------------------------------
if ( "" eq $sPool )
{
  @pool_list = &GetPoolList();
  &GetVipsFromPool(@pool_list);
}
else
{
  &GetVipsFromPool($sPool);
}