Perl Ltm Config To Xml (version 2)

Problem this snippet solves:
This example is based on "Perl Ltm Config To Xml" by Joe Pruitt: queries the components of a virtual servers configuration and prints it out in an XML format for further processing. Now with a few more data retrieved (SNAT, object status) and does recursively on partitions, this way listing configuration generated by iApps on separate partitions.
How to use this snippet:
./LTM-to-XML.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,
    "{urn:iControl}LocalLB.AvailabilityStatus" => 1,
    "{urn:iControl}LocalLB.MonitorStatus" => 1,
    "{urn:iControl}LocalLB.EnabledStatus" => 1,
    "{urn:iControl}Common.EnabledState" => 1,
    "{urn:iControl}Common.VLANFilterList" => 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;
}
 
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;
}

# Status conversion 
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",
  };

# Get config  
sub GetConfigXML()
{
    # Enable Recursive Partition/Folder lookup and set /Common as active folder
    $SystemSession = &GetInterface("System", "Session");
    $soapResponse = $SystemSession->set_recursive_query_state(
        SOAP::Data->name(state => "STATE_ENABLED")
    );
    &checkResponse($soapResponse);
    $soapResponse = $SystemSession->set_active_folder(
    SOAP::Data->name(folder => "/")
    );
    
    # Get data
    $LocalLBVirtualServer = &GetInterface("LocalLB", "VirtualServer");
    $LocalLBPool = &GetInterface("LocalLB", "Pool");
    $LocalLBPoolMember = &GetInterface("LocalLB", "PoolMember");
    $LocalLBSNATPool = &GetInterface("LocalLB", "SNATPool");

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

    # Destination
    $soapResponse = $LocalLBVirtualServer->get_destination_v2(
    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};

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

    # ensure we don't pass empty entries to the following methods.  
    @snat_list2 = &FixEmptyEntries(@snat_list);

    # SNAT Pool Members
    $soapResponse = $LocalLBSNATPool->get_member_v2(
    SOAP::Data->name(snat_pools => [@snat_list2])
    );
    &checkResponse($soapResponse);
    @snatmember_listA = @{$soapResponse->result};

    # State
    $soapResponse = $LocalLBVirtualServer->get_enabled_state(
    SOAP::Data->name(virtual_servers => [@vs_list])
    );
    &checkResponse($soapResponse);
    @state_list = @{$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_v2(
    SOAP::Data->name(pool_names => [@pool_list2])
    );
    &checkResponse($soapResponse);
    @member_listA = @{$soapResponse->result};

    # Member/Monitor Status
    $soapResponse = $LocalLBPoolMember->get_monitor_status(
    SOAP::Data->name(pool_names => [@pool_list2])
    );
    &checkResponse($soapResponse);
    @monitor_statusA = @{$soapResponse->result};

    $soapResponse = $LocalLBPoolMember->get_object_status(
    SOAP::Data->name(pool_names => [@pool_list2])
    );
    &checkResponse($soapResponse);
    @object_statusA = @{$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 XML
    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];
        $snat = @snat_list[$i];
        $state = @state_list[$i];
        @rule_list = @{$rule_listA[$i]};
        @profile_list = @{$profile_listA[$i]};
        @persistenceprofile_list = @{$persistenceprofile_listA[$i]};

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

        # SNAT
        @snatmember_list = @{$snatmember_listA[$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];
          $name = $profile->{"profile_name"};
          $type = $profile->{"profile_type"};
          $context = $profile->{"profile_context"};
          $default = $pprofile->{"default_profile"};
          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"};
            $monitorS = @monitor_status[$j]->{"monitor_status"};
            $objectS = @object_status[$j]->{"object_status"};
$enabledS = $objectS->{"enabled_status"};
            $status = "$MONITOR_STATUS_MAP->{$monitorS}-$ENABLED_STATUS_MAP->{$enabledS}";
            print "        \n";
          }
          
          $type = $monitor_rule->{"type"};
          @templates = @{$monitor_rule->{"monitor_templates"}};
          print "        \n";
          for $j (0 .. $#templates)
          {
            $template = @templates[$j];
            print "          \n";
          }
          print "        \n";
          
          print "      \n";
        }

        if ( $snat ne "" ) 
        {
          print "      \n";
          for $j (0 .. $#snatmember_list)
          {
            $snatmember = @snatmember_list[$j];
            print "        \n";
          }
          print "      \n";
        }

        print "    \n";
    }
    print "  \n";
    print "\n";
    
    # Set /Common as active folder
    $soapResponse = $SystemSession->set_active_folder(
    SOAP::Data->name(folder => "/")
    );
    &checkResponse($soapResponse);
}

&GetConfigXML();
 
 
#----------------------------------------------------------------------------
# checkResponse
#----------------------------------------------------------------------------
sub checkResponse()
{
  my ($soapResponse) = (@_);
  if ( $soapResponse->fault )
  {
    print $soapResponse->faultcode, " ", $soapResponse->faultstring, "\n";
    exit();
  }
}
Tested this on version:
12.0
Published Jan 04, 2017
Version 1.0
BIG-IP
community contributed