Perl Virtual Server Conn Limit

Problem this snippet solves:

This Perl application will either query the list of virtual servers, or get or set the connection limit for a specified virtual server.

Code :

#!/usr/bin/perl
#----------------------------------------------------------------------------
# The contents of this file are subject to the iControl Public License
# Version 4.5 (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-2008 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;
#----------------------------------------------------------------------------
# Validate Arguments
#----------------------------------------------------------------------------
my $sHost = $ARGV[0];
my $sPort = $ARGV[1];
my $sUID = $ARGV[2];
my $sPWD = $ARGV[3];
my $sVirtual = $ARGV[4];
my $sLimit = $ARGV[5];
my $sProtocol = "https";

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

sub usage()
{
  die ("Usage: VirtualServerConLimit.pl host port uid pwd virtual\n");
}

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
  -> readable(1)
  -> proxy("$sProtocol://$sHost:$sPort/iControl/iControlPortal.cgi");

#----------------------------------------------------------------------------
# Attempt to add auth headers to avoid dual-round trip
#----------------------------------------------------------------------------
eval { $VirtualServer->transport->http_request->header
(
  'Authorization' =>
  'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')-->
); };


#----------------------------------------------------------------------------
# Main logic
#----------------------------------------------------------------------------
if ( "" eq $sVirtual )
{
  GetVSList();
}
elsif ( "" eq $sLimit )
{
  GetVSConLimit($sVirtual);
}
else
{
  SetVSConLimit($sVirtual, $sLimit);
}

#----------------------------------------------------------------------------
# sub GetVSList
#----------------------------------------------------------------------------
sub GetVSList()
{
  $soapResponse = $VirtualServer->get_list();
  &checkResponse($soapResponse);
  @vs_list = @{$soapResponse->result};
  print "Virtual Server List\n";
  print "-------------------\n";
  foreach $vs (@vs_list)
  {
    print "  $vs\n";
  }
}

#----------------------------------------------------------------------------
# sub GetVSConLimit
#----------------------------------------------------------------------------
sub GetVSConLimit()
{
  my ($virtual) = (@_);
  
  $soapResponse = $VirtualServer->get_connection_limit(
    SOAP::Data->name(virtual_servers => [$virtual])
  );
  &checkResponse($soapResponse);
  @limits = @{$soapResponse->result};
  foreach $limit (@limits)
  {
    $low = $limit->{"low"};
    $high = $limit->{"high"};
    $val = ($high<<32)|$low;
    print "Virtual Server '$virtual' Conn Limit: $val\n";
  }
}

#----------------------------------------------------------------------------
# sub SetVSConLimit
#----------------------------------------------------------------------------
sub SetVSConLimit()
{
  my ($virtual, $limit) = (@_);
  
  $ULong64 = {
    low => $limit,
    high => 0
  };
  
  $soapResponse = $VirtualServer->set_connection_limit(
    SOAP::Data->name(virtual_servers => [$virtual]),
    SOAP::Data->name(limits => [$ULong64])
  );
  &checkResponse($soapResponse);
  
  &GetVSConLimit($virtual);
}

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