Perl Virtual Show

Problem this snippet solves:

This example will illustrate the APIs needed to emulate the "bigpipe virtual show" command.

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;

$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;

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

my $LB_METHOD_MAP = 
  {
    "LB_METHOD_ROUND_ROBIN" => "round_robin",
    "LB_METHOD_RATIO_MEMBER" => "ratio",
    "LB_METHOD_LEAST_CONNECTION_MEMBER" => "least_connection_member",
    "LB_METHOD_OBSERVED_MEMBER" => "observed_member",
    "LB_METHOD_PREDICTIVE_MEMBER" => "predictive_member",
    "LB_METHOD_RATIO_NODE_ADDRESS" => "ratio_node_address",
    "LB_METHOD_LEAST_CONNECTION_NODE_ADDRESS" => "least_connection_node_address",
    "LB_METHOD_FASTEST_NODE_ADDRESS" => "fastest_node_address",
    "LB_METHOD_OBSERVED_NODE_ADDRESS" => "observed_node_address",
    "LB_METHOD_PREDICTIVE_NODE_ADDRESS" => "predictive_node_address",
    "LB_METHOD_DYNAMIC_RATIO" => "dynamic_ratio",
    "LB_METHOD_FASTEST_APP_RESPONSE" => "fastest_app_response",
    "LB_METHOD_LEAST_SESSIONS" => "least_sessions",
    "LB_METHOD_DYNAMIC_RATIO_MEMBER" => "dynamic_ratio_member",
    "LB_METHOD_L3_ADDR" => "l3_addr",
    "LB_METHOD_UNKNOWN" => "unknown",
    "LB_METHOD_WEIGHTED_LEAST_CONNECTION_MEMBER" => "weighted_least_connection_member",
    "LB_METHOD_WEIGHTED_LEAST_CONNECTION_NODE_ADDRESS" => "weighted_least_connection_node_address",
    "LB_METHOD_RATIO_SESSION" => "ratio_session",
    "LB_METHOD_RATIO_LEAST_CONNECTION_MEMBER" => "ratio_least_connection_member",
    "LB_METHOD_RATIO_LEAST_CONNECTION_NODE_ADDRESS" => "ratio_least_connection_node_address",
  };


my $MONITOR_STATUS_MAP = 
  {
    "MONITOR_STATUS_UNCHECKED" => "UNCHECKED",
    "MONITOR_STATUS_CHECKING" => "CHECKING",
    "MONITOR_STATUS_UP" => "UP",
    "MONITOR_STATUS_DOWN" => "DOWN",
    "MONITOR_STATUS_FORCED_DOWN" => "FORCED_DOWN",
    "MONITOR_STATUS_MAINT" => "MAINT",
    "MONITOR_STATUS_ADDRESS_DOWN" => "ADDRESS_DOWN",
  };

my $ENABLED_STATUS_MAP = 
  {
    "ENABLED_STATUS_NONE" => "NONE",
    "ENABLED_STATUS_ENABLED" => "ENABLED",
    "ENABLED_STATUS_DISABLED" => "DISABLED",
    "ENABLED_STATUS_DISABLED_BY_PARENT" => "DISABLED_BY_PARENT",
  };

my $ENABLED_STATE_MAP = 
  {
    "STATE_ENABLED" => "ENABLED",
    "STATE_DISABLED" => "DISABLED",
  };

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

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


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

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

sub SOAP::Deserializer::typecast
{
  my ($self, $value, $name, $attrs, $children, $type) = @_;
  my $retval = undef;
  if ( $type eq "{urn:iControl}Common.EnabledState" )
  { $retval = $value; }
  elsif ( $type eq "{urn:iControl}LocalLB.LBMethod" )
  { $retval = $value; }
  elsif ( $type eq "{urn:iControl}LocalLB.MonitorStatus" )
  { $retval = $value; }
  elsif ( $type eq "{urn:iControl}LocalLB.AvailabilityStatus" )
  { $retval = $value; }
  elsif ( $type eq "{urn:iControl}LocalLB.EnabledStatus" )
  { $retval = $value; }
  elsif ( $type eq "{urn:iControl}LocalLB.ProfileType" )
  { $retval = $value; }
  elsif ( $type eq "{urn:iControl}LocalLB.ProfileContextType" )
  { $retval = $value; }
  return $retval;
}

#----------------------------------------------------------------------------
# App logic
#----------------------------------------------------------------------------

if ( $sVirtual eq "" )
{
  &DoVirtualShow();
}
else
{
  &DoVirtualShow($sVirtual);
}

#----------------------------------------------------------------------------
# usage
#----------------------------------------------------------------------------
sub usage()
{
  my ($sCmd) = @_;
  print "Usage: VirtualShow.pl host port uid pwd [virtual_name]\n";
  exit();
}

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



#----------------------------------------------------------------------------
# DoVirtualShow
#----------------------------------------------------------------------------
sub DoVirtualShow()
{
  (@vs_lists) = @_;

  if ( 0 == scalar(@vs_lists) )
  {
    $soapResponse = $VirtualServer->get_list();
    &checkResponse($soapResponse);
    @vs_lists = @{$soapResponse->result};
  }

#  $soapResponse = $VirtualServer->get_profile
#  (
#    SOAP::Data->name(virtual_servers => [@vs_lists])
#  );
#  &checkResponse($soapResponse);
#  print "received profile list!\n";
#  exit();

  # Set the default chunk size
  $chunk_size = 10;
  # Set the time threshold per call (in seconds)
  $time_threshold = 10; 

  $total_size = scalar(@vs_lists);

  for ($i=0; $i<$total_size; $i+=$last_chunk_size)
  {
    if ( ($total_size - $i) < $chunk_size )
    {
      $chunk_size = ($total_size - $i);
    }

    $last_chunk_size = $chunk_size;

    # Make sure chunk array is empty
    @chunk_list = ();
    undef @chunk_list;
    
    # fill new array
    for ($j=0; $j<$chunk_size; $j++)
    {
      $val = @vs_lists[$i+$j];
      push @chunk_list, $val
    }
    
    # Get Start Time
    $start_time = time();
    
    # Make calls
    print "Querying $chunk_size elements\n";
    &DoVirtualShowEx(@chunk_list);
    
    # Get Stop Time
    $end_time = time();

    $chunk_time = $end_time - $start_time;

    #print "Time this section: $chunk_time s.\n";

    # increment total time
    $total_time += ($chunk_time);
    
    if ( $chunk_time < $time_threshold )
    {
      $chunk_size *= 2;
    }
  }
  
  print "Total execution time: $total_time s.\n";
}

#----------------------------------------------------------------------------
# DoVirtualShowEx
#----------------------------------------------------------------------------
sub DoVirtualShowEx()
{
  (@vs_list) = @_;
  
  # get the vs destinations
  $soapResponse = $VirtualServer->get_destination
  (
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @vs_dest_list = @{$soapResponse->result};
  
  # get the enabled states
  $soapResponse = $VirtualServer->get_enabled_state
  (
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @vs_enabled_list = @{$soapResponse->result};

  # Get the default pool names
  $soapResponse = $VirtualServer->get_default_pool_name
  (
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @pool_list = @{$soapResponse->result};

  # Get Pool lb methods
  $soapResponse = $Pool->get_lb_method
  (
    SOAP::Data->name(pool_names => [@pool_list])
  );
  #&checkResponse($soapResponse);
  @pool_lb_method_list = @{$soapResponse->result};
  
  # Get Pool Member Monitor statuses
  $soapResponse = $PoolMember->get_monitor_status
  (
    SOAP::Data->name(pool_names => [@pool_list])
  );
  #&checkResponse($soapResponse);
  @poolmember_monitor_statuses = @{$soapResponse->result};
  
  # Get Pool Member object statuses
  $soapResponse = $PoolMember->get_object_status
  (
    SOAP::Data->name(pool_names => [@pool_list])
  );
  #&checkResponse($soapResponse);
  @poolmember_object_statuses = @{$soapResponse->result};
  
  # Get Pool Member Priorities
  $soapResponse = $PoolMember->get_priority
  (
    SOAP::Data->name(pool_names => [@pool_list])
  );
  #&checkResponse($soapResponse);
  @poolmember_member_priorities = @{$soapResponse->result};
  
  # print results

  for $i (0 .. scalar(@vs_list)-1)
  {
    print "VIRTUAL SERVER @vs_list[$i] @vs_dest_list[$i]->{'address'}:@vs_dest_list[$i]->{'port'}\n";

    print "  vip_IP                 = '@vs_dest_list[$i]->{'address'}\n";
    print "  vip_Name               = '@vs_list[$i]'\n";
    print "  vip_Port               = '@vs_dest_list[$i]->{'port'}\n";

    print "  vip_Pool_Name          = '@pool_list[$i]'\n";
    print "  vip_Port_Status        = '$ENABLED_STATE_MAP->{@vs_enabled_list[$i]}'\n";
    print "  pool_LB_Method         = '$LB_METHOD_MAP->{@pool_lb_method_list[$i]}'\n";

    @monitor_status_entry = @{$poolmember_monitor_statuses[$i]};
    @object_status_entry = @{$poolmember_object_statuses[$i]};
    @member_priority_entry = @{$poolmember_member_priorities[$i]};

    for $j (0 .. scalar(@monitor_status_entry)-1)
    {
      $member = @monitor_status_entry[$j]->{"member"};
      $address = $member->{"address"};
      $port = $member->{"port"};
      $monitor_status = @monitor_status_entry[$j]->{"monitor_status"};

      $object_status = @object_status_entry[$j]->{"object_status"};
      $enabled_status = $object_status->{"enabled_status"};
      $combined_status = "$MONITOR_STATUS_MAP->{$monitor_status}-$ENABLED_STATUS_MAP->{$enabled_status}";

      $member_priority = @member_priority_entry[$j]->{"priority"};

      print "  +-pool_Member_IP       = '$address'\n";
      print "    pool_Member_Port     = '$port'\n";
      #print "    pool_Member_Name     = 'TODO: RESOLVE VIA DNS'\n";
      print "    pool_Member_State    = '$combined_status'\n";
      print "    pool_Member_Priority = '$member_priority'\n";
    }
  }
}
Published Mar 09, 2015
Version 1.0

Was this article helpful?

No CommentsBe the first to comment