Perl Virtual Server Rule

Problem this snippet solves:

Working with 2-d arrays in perl can be a bit tricky so I wrote this bit of code to illustrate how to extract them from a response as well as packaging them for a request. This example uses the LocalLB VirtualServer's iRule methods to query the iRules associated with a virtual server as well as allowing you to add/remove iRules from 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 + trace => qw(method debug);
use SOAP::Lite;
#----------------------------------------------------------------------------
# Validate Arguments
#----------------------------------------------------------------------------
my $sHost = $ARGV[0];
my $sPort = $ARGV[1];
my $sUID = $ARGV[2];
my $sPWD = $ARGV[3];
my $sCmd = $ARGV[4];
my $sVirtual = $ARGV[5];
my $sRule = $ARGV[6];
my $sPriority = $ARGV[7];
my $sProtocol = "https";

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

sub usage()
{
  die ("Usage: VirtualServerRule.pl host port uid pwd [[list|add|remove] [virtual [iRule priority]]]\n");
}

if ( ($sHost eq "") or ($sPort eq "") or ($sUID eq "") or ($sPWD eq "") or ($sCmd 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 ( "list" eq $sCmd )
{
  getVSRules($sVirtual);
}
elsif ( "add" eq $sCmd )
{
  addVSRule($sVirtual, $sRule, $sPriority);
}
elsif ( "remove" eq $sCmd )
{
  removeVSRule($sVirtual, $sRule);
}
else
{
  usage();
}

#----------------------------------------------------------------------------
# sub getVSRule
#----------------------------------------------------------------------------
sub getVSRules()
{
  my ($virtual) = (@_);
  
  my @vs_list;
  if ( "" eq $virtual )
  {
    $soapResponse = $VirtualServer->get_list();
    &checkResponse($soapResponse);
    @vs_list = @{$soapResponse->result};
  }
  else
  {
    push @vs_list, $virtual;
  }
  $soapResponse = $VirtualServer->get_rule(
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @VirtualServerRuleAofA = @{$soapResponse->result};
  
  for $i (0 .. $#vs_list)
  {
    $vs = @vs_list[$i];
    @VirtualServerRuleList = @{$VirtualServerRuleAofA[$i]};
    
    print "Virtual '$vs'\n";
    foreach $VirtualServerRule (@VirtualServerRuleList)
    {
      $rule_name = $VirtualServerRule->{"rule_name"};
      $priority = $VirtualServerRule->{"priority"};
      print "  $rule_name (pri = $priority)\n";
    }
  }
}

#----------------------------------------------------------------------------
# sub addVSRule
#----------------------------------------------------------------------------
sub addVSRule()
{
  my ($virtual, $rulename, $priority) = (@_);
  if ( ("" eq $virtual) or ("" eq $rulename) or ("" eq $priority) )
  {
    usage();
  }
  
  $VirtualServerRule = {
    rule_name => $rulename,
    priority => $priority
  };
  push @VirtualServerRuleList, $VirtualServerRule;
  push @VirtualServerRuleAofA, [@VirtualServerRuleList];
  
  $soapResponse = $VirtualServer->add_rule(
    SOAP::Data->name(virtual_servers => [$virtual]),
    SOAP::Data->name(rules => [@VirtualServerRuleAofA])
  );
  &checkResponse($soapResponse);
  &getVSRules($virtual);
}

#----------------------------------------------------------------------------
# sub removeVSRule
#----------------------------------------------------------------------------
sub removeVSRule()
{
  my ($virtual, $rulename) = (@_);
  if ( ("" eq $virtual) or ("" eq $rulename) )
  {
    usage();
  }
  
  $VirtualServerRule = {
    rule_name => $rulename,
    priority => 0
  };
  push @VirtualServerRuleList, $VirtualServerRule;
  push @VirtualServerRuleAofA, [@VirtualServerRuleList];
  
  $soapResponse = $VirtualServer->remove_rule(
    SOAP::Data->name(virtual_servers => [$virtual]),
    SOAP::Data->name(rules => [@VirtualServerRuleAofA])
  );
  &checkResponse($soapResponse);
  &getVSRules($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();
  }
}