Perl Ltm Config To Xml

Problem this snippet solves:

This example queries the components of a virtual servers configuration and prints it out in an XML format for further processing.

How to use this snippet:

.\PerlLtmConfigToXml.pl bigip user pass

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-2003 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 $BIGIP = $ARGV[0];
my $User = $ARGV[1];
my $Pass = $ARGV[2];

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


if ( ($BIGIP eq "") or ($User eq "") or ($Pass eq "") )
{
  usage();
}

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

$urnMap = {
    "{urn:iControl}LocalLB.LBMethod" => 1,
    "{urn:iControl}LocalLB.MonitorRuleType" => 1,
    "{urn:iControl}LocalLB.ProfileContextType" => 1,
    "{urn:iControl}LocalLB.ProfileType" => 1,
    "{urn:iControl}LocalLB.VirtualServer.VirtualServerType" => 1,
};
sub SOAP::Deserializer::typecast
{
  my ($self, $value, $name, $attrs, $children, $type) = @_;
  my $retval = undef;
  if ( 1 == $urnMap->{$type} )
  {
    $retval = $value;
  }
  return $retval;
}

sub GetInterface()
{
  my ($module, $name) = @_;
  
  $interface = SOAP::Lite
    -> uri("urn:iControl:$module/$name")
    -> readable(1)
    -> proxy("https://$BIGIP/iControl/iControlPortal.cgi");
  eval { $interface->transport->http_request->header
  ( 'Authorization' => 'Basic ' . MIME::Base64::encode("$User:$Pass", '') ); };

  return $interface;
}

&GetConfigXML();

sub FixEmptyEntries()
{
  my @list1 = @_;
  my @list2;
  
  my $valid_item = "";
  
  for $i (0 .. $#list1)
  {
  
    $item = @list1[$i];
    if ( $item ne "" )
    {
      $valid_item = $item;
      break;
    }
  }
  
  for $i (0 .. $#list1)
  {
    $item = @list1[$i];
    if ( $item ne "" ) { push @list2, $item; }
    else               { push @list2, $valid_item; }
  }
  return @list2;
}

sub GetConfigXML()
{
  $LocalLBVirtualServer = &GetInterface("LocalLB", "VirtualServer");
  $LocalLBPool = &GetInterface("LocalLB", "Pool");
  $LocalLBPoolMember = &GetInterface("LocalLB", "PoolMember");

  # VS List
  $soapResponse = $LocalLBVirtualServer->get_list();
  &checkResponse($soapResponse);
  @vs_list = @{$soapResponse->result};

  # Destination
  $soapResponse = $LocalLBVirtualServer->get_destination(
    SOAP::Data->name (virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @destination_list = @{$soapResponse->result};
  
  # Type
  $soapResponse = $LocalLBVirtualServer->get_type(
    SOAP::Data->name (virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @vstype_list = @{$soapResponse->result};
  
  # iRules
  $soapResponse = $LocalLBVirtualServer->get_rule(
    SOAP::Data->name (virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @rule_listA = @{$soapResponse->result};
  
  # Profiles
  $soapResponse = $LocalLBVirtualServer->get_profile(
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @profile_listA = @{$soapResponse->result};
  
  $soapResponse = $LocalLBVirtualServer->get_persistence_profile(
    SOAP::Data->name(virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @persistenceprofile_listA = @{$soapResponse->result};

  # Pools
  $soapResponse = $LocalLBVirtualServer->get_default_pool_name(
    SOAP::Data->name (virtual_servers => [@vs_list])
  );
  &checkResponse($soapResponse);
  @pool_list = @{$soapResponse->result};

  # ensure we don't pass empty entries to the following methods.  
  @pool_list2 = &FixEmptyEntries(@pool_list);
  
  # Pool Members
  $soapResponse = $LocalLBPool->get_member(
    SOAP::Data->name(pool_names => [@pool_list2])
  );
  &checkResponse($soapResponse);
  @member_listA = @{$soapResponse->result};
  
  # LB Method
  $soapResponse = $LocalLBPool->get_lb_method(
    SOAP::Data->name(pool_names => [@pool_list2])
  );
  &checkResponse($soapResponse);
  @lbmethod_list = @{$soapResponse->result};
  
  $soapResponse = $LocalLBPool->get_monitor_association(
    SOAP::Data->name(pool_names => [@pool_list2])
  );
  &checkResponse($soapResponse);
  @monitor_list = @{$soapResponse->result};
  
  print "\n";
  print "\n";
  print "  \n";
  for $i (0 .. $#vs_list)
  {
    # vip
    $vip = @vs_list[$i];
    $pool = @pool_list[$i];
    $destination = @destination_list[$i];
    $vstype = @vstype_list[$i];
    @rule_list = @{$rule_listA[$i]};
    @profile_list = @{$profile_listA[$i]};
    @persistenceprofile_list = @{$persistenceprofile_listA[$i]};

    # pool
    @member_list = @{$member_listA[$i]};
    $monitorassociations = @monitor_list[$i];
    $monitor_rule = $monitorassociations->{"monitor_rule"};
    $lb_method = $lbmethod_list[$i];

    $daddr = $destination->{"address"};
    $dport = $destination->{"port"};
    print "    \n";
    
    for $j (0 .. $#rule_list)
    {
      $rule = @rule_list[$j];
      $name = $rule->{"rule_name"};
      $priority = $rule->{"priority"};
      print "      \n";
    }
    
    for $j (0 .. $#profile_list)
    {
      $profile = @profile_list[$j];
      $type = $profile->{"profile_type"};
      $context = $profile->{"profile_context"};
      $name = $profile->{"profile_name"};
      print "      \n";
    }
    
    for $j (0 .. $#persistenceprofile_list)
    {
      $pprofile = @persistenceprofile_list[$j];
      $name = $pprofile->{"profile_name"};
      $default = $pprofile->{"default_profile"};
      print "      \n";
    }
    
    if ( $pool ne "" ) 
    {
      print "      \n";
      for $j (0 .. $#member_list)
      {
        $member = @member_list[$j];
        $address = $member->{"address"};
        $port = $member->{"port"};
        print "        \n";
      }
      
      $type = $monitor_rule->{"type"};
      $quorum = $monitor_rule->{"quorum"};
      @templates = @{$monitor_rule->{"monitor_templates"}};
      print "        \n";
      for $j (0 .. $#templates)
      {
        $template = @templates[$j];
        print "          \n";
      }
      print "        \n";
      
      print "      \n";
    }
    print "    \n";
  }
  print "  \n";
  print "\n";
}


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

Was this article helpful?

5 Comments

  • I kept getting the "500 Can't connect to 10.39.253.5:443 (Certificate verify failed) at PerlLtmConfigToXml.pl line 127" when I tried to run the script. How can I resolve the issue?
  • this script is greate i tested it and works awsome. But i have a challange, we have multiple partations but this script only exports configuration from comman partation. Please let me know what changes is requuired to get the configuration from other partations
  • Sorry if this is a basic question, but not a lot of perl experience here... Can this script parse an offline copy of the config file or is direct access to the LTM required? Thanks
  • Thanks We had a few issues with the script. One which may have been related to the system used to run the Perl and SOAP Lite related to certificate trust. Here is the error. 500 Can't verify SSL peers without knowing which Certificate Authorities to trust at ./PerlLtmConfigToXml.pl line 128. We added this to the code to not verify SSL use SOAP::Lite + trace => qw(method debug); ---------------------------------------------------------------------------- $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; use IO::Socket::SSL; IO::Socket::SSL::set_defaults(SSL_verify_mode => "SSL_VERIFY_NONE"); use SOAP::Lite + trace => qw(method debug); use SOAP::Lite; use SOAP::Lite; Also, the first virtual server in our xml output had no destination address:port and all the other virtual server destination ip's and member ip's were off We solved this by modifying the print statement variables: ORIGINAL $daddr = $destination->{"address"}; $dport = $destination->{"port"}; print " \n"; NEW $daddr = $destination->{"address"}; $dport = $destination->{"port"}; print " \n";