Perl Address Class

Problem this snippet solves:

This perl sample illustrates how to use the iControl methods to manipulate address datagroups.

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-2010 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 $sCMD = $ARGV[3];
my $sCMDARG1 = $ARGV[4];
my $sCMDARG2 = $ARGV[5];
my $sCMDARG3 = $ARGV[6];

sub usage()
{
  print "Usage: addressClass.pl host uid pwd cmd [cmdargs] \n";
  print "  cmd      args                     Description\n";
  print "  ------   ----------------------   -----------------------------------\n";
  print "  list                            - list address classes\n";
  print "  create   classname              - create a new address class\n";
  print "  delete   classname              - remove address class\n";
  print "  add      classname addr/netmask - Add addr/netmask to address class\n";
  print "  remove   classname addr/netmask - Remove addr/netmask from address class\n";
  exit;
}

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

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


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


#----------------------------------------------------------------------------
# Main program logic
#----------------------------------------------------------------------------
$processed = 0;
if ( "list" eq $sCMD )
{
  &listClasses($sCMDARG1);
  $processed = 1;
}
elsif ( "create" eq $sCMD )
{
  if ( "" ne $sCMDARG1 )
  {
    &createAddressClass($sCMDARG1);
    &listClasses();
    $processed = 1;
  }
}
elsif ( "delete" eq $sCMD )
{
  if ( "" ne $sCMDARG1 )
  {
    &deleteAddressClass($sCMDARG1);
    &listClasses();
    $processed = 1;
  }
}
elsif ( "add" eq $sCMD )
{
  if ( ("" ne $sCMDARG1) && ("" ne $sCMDARG2) )
  {
    &addMemberToClass($sCMDARG1, $sCMDARG2);
    &listClasses($sCMDARG1);
    $processed = 1;
  }
}
elsif ( "remove" eq $sCMD )
{
  if ( ("" ne $sCMDARG1) && ("" ne $sCMDARG2) )
  {
    removeMemberFromClass($sCMDARG1, $sCMDARG2);
    &listClasses($sCMDARG1);
    $processed = 1;
  }
}

if ( $processed == 0 )
{
  &usage();
}

#----------------------------------------------------------------------------
# sub listClasses
#----------------------------------------------------------------------------
sub listClasses()
{
  ($class) = (@_);
  if ( $class )
  {
    push @ClassList, $class;
  }
  else
  {
    $soapResponse = $Class->get_address_class_list();
    &checkResponse($soapResponse);
    @ClassList = @{$soapResponse->result};
  }

  $soapResponse = $Class->get_address_class
  (
    SOAP::Data->name(class_names => [@ClassList])
  );
  &checkResponse($soapResponse);
  @AddressClassA = @{$soapResponse->result};
  foreach $AddressClass (@AddressClassA)
  {
    $name = $AddressClass->{"name"};
    print "Name : $name\n";
    @AddressEntryA = @{$AddressClass->{"members"}};
    foreach $AddressEntry (@AddressEntryA)
    {
      $address = $AddressEntry->{"address"};
      $netmask = $AddressEntry->{"netmask"};
      print "     : ${address}/${netmask}\n";
    }
  }
}

#----------------------------------------------------------------------------
# sub createAddressClass
#----------------------------------------------------------------------------
sub createAddressClass()
{
  ($class) = (@_);
  
  # create class with no members.
  $members;
  $AddressClass =
  {
    name => $class, 
    members => ""
  };
  
  $soapResponse = $Class->create_address_class
  (
    SOAP::Data->name(classes => [$AddressClass])
  );
  &checkResponse($soapResponse);
}

#----------------------------------------------------------------------------
# sub deleteAddressClass
#----------------------------------------------------------------------------
sub deleteAddressClass()
{
  ($class) = (@_);
  $soapResponse = $Class->delete_class
  (
    SOAP::Data->name(classes => [$class])
  );
  &checkResponse($soapResponse);
}

#----------------------------------------------------------------------------
# sub addMemberToClass
#----------------------------------------------------------------------------
sub addMemberToClass()
{
  my ($class, $address) = (@_);
  my ($addr, $mask) = split(/\//, $address, 2);

  if ( "" eq $mask ) { $mask = "255.255.255.255"; }

  $AddressEntry =
  {
    address => $addr,
    netmask => $mask
  };

  $AddressClass =
  {
    name => $class, 
    members => [$AddressEntry]
  };
  
  $soapResponse = $Class->add_address_class_member
  (
    SOAP::Data->name(class_members => [$AddressClass])
  );
  &checkResponse($soapResponse);
}

#----------------------------------------------------------------------------
# sub removeMemberFromClass
#----------------------------------------------------------------------------
sub removeMemberFromClass()
{
  my ($class, $address) = (@_);
  my ($addr, $mask) = split(/\//, $address, 2);

  if ( "" eq $mask ) { $mask = "255.255.255.255"; }

  $AddressEntry =
  {
    address => $addr,
    netmask => $mask
  };

  $AddressClass =
  {
    name => $class, 
    members => [$AddressEntry]
  };
  
  $soapResponse = $Class->delete_address_class_member
  (
    SOAP::Data->name(class_members => [$AddressClass])
  );
  &checkResponse($soapResponse);
}

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