Perl PoolMember Monitor

Problem this snippet solves:

This sample illustrates how to get and set a monitor association with a pool member.

Code :

#!/usr/bin/perl
#----------------------------------------------------------------------------
# The contents of this file are subject to the iControl Public License
# Version 9.2 (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-2011
# 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 strict;
use warnings;
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
#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 $sPool = $ARGV[3];
my $sMember = $ARGV[4];
my $sMonitor = $ARGV[5];

sub usage()
{
        die ("Usage: PoolMemberMonitor.pl host port uid pwd [pool [member:port [monitor]]]\n");
}

if ( !defined($sHost)  or !defined($sUID) or !defined($sPWD) )
{
        usage();
}

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


#----------------------------------------------------------------------------
# GetInterface
#----------------------------------------------------------------------------
sub GetInterface()
{
  my ($name) = (@_);
  my $Interface = SOAP::Lite
    -> uri("urn:iControl:$name")
    -> readable(1)
    -> proxy("https://$sHost/iControl/iControlPortal.cgi");
# $Interface->set_opt(verify
    
  #----------------------------------------------------------------------------
  # Attempt to add auth headers to avoid dual-round trip
  #----------------------------------------------------------------------------
  eval { $Interface->transport->http_request->header
  (
    'Authorization' => 'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')
  ); };
  
  return $Interface;
}

my $Pool = &GetInterface("LocalLB/Pool");
my $PoolMember = &GetInterface("LocalLB/PoolMember");

#----------------------------------------------------------------------------
# support for custom enum types
#----------------------------------------------------------------------------
sub SOAP::Deserializer::typecast
{
        my ($self, $value, $name, $attrs, $children, $type) = @_;
        my $retval = undef;
        if ( defined($type) && "{urn:iControl}Common.EnabledState" eq $type ){
                $retval = $value;
        }
        return $retval;
}

#----------------------------------------------------------------------------
# Main logic
#----------------------------------------------------------------------------
if ( !defined($sPool)||$sPool eq '' )
{
  &getPoolList();
}
elsif ( "" eq $sMember )
{
  &getPoolMembers($sPool);
}
elsif ( "" eq $sMonitor )
{
  &getPoolMemberMonitors($sPool, $sMember);
}
else
{
  &setPoolMemberMonitor($sPool, $sMember, $sMonitor);
}

sub getPoolList()
{
  my $soapResponse = $Pool->get_list();
  &checkResponse($soapResponse);
  my @pool_list = @{$soapResponse->result};
  print "AVAILBLE POOLS\n";
  foreach my $pool (@pool_list)
  {
    print "$pool\n";
  }
}

sub getPoolMembers()
{
  my ($pool) = (@_);
  my $soapResponse = $Pool->get_member(
    SOAP::Data->name(pool_names => [$pool])
  );
  &checkResponse($soapResponse);
  my @memberListAofA = @{$soapResponse->result};
  
  # Extract the 1st list for the single pool passed in.
  my @memberListA = @{$memberListAofA[0]};

  print "POOL '$pool' members\n";
  # build parameters for set_session_enabled_state();
  foreach my $member_def (@memberListA)
  {
    my $address = $member_def->{"address"};
    my $port = $member_def->{"port"};
    
    print "  ${address}:${port}\n";
  }
}

sub getPoolMemberMonitors()
{
  my ($pool, $member) = (@_);
  my ($addr, $port) = split(/:/, $member, 2);
  
  my $soapResponse = $PoolMember->get_monitor_association(
    SOAP::Data->name(pool_names => [$pool])
  );
  &checkResponse($soapResponse);
  my @MonitorAssociationAofA = @{$soapResponse->result};
  my @MonitorAssociationA = @{$MonitorAssociationAofA[0]};
  
  print "POOL '$pool' monitors\n";
  foreach my $MonitorAssociation (@MonitorAssociationA)
  {
    my $MonitorIPPort = $MonitorAssociation->{"member"};
    my $atype = $MonitorIPPort->{"address_type"};
    my $ipport = $MonitorIPPort->{"ipport"};
    my $addr = $ipport->{"address"};
    my $port = $ipport->{"port"};
    
    my $MonitorRule = $MonitorAssociation->{"monitor_rule"};
    my $type = $MonitorRule->{"type"};
    my $quorum = $MonitorRule->{"quorum"};
    
    print "  ${addr}:${port} - ${atype}\n";
    print "    Type: ${type}, Quorum: ${quorum}\n";
    
    my @monitor_templates = @{$MonitorRule->{"monitor_templates"}};
    foreach my $monitor_template (@monitor_templates)
    {
      print "    $monitor_template\n";
    }
  }
}

sub setPoolMemberMonitor()
{
  my ($pool, $member, $monitor) = (@_);
  my ($addr, $port) = split(/:/, $member, 2);
  
  my $IPPortDefinition = {
    address => $addr,
    port => $port
  };
  
        my $MonitorIP = {
                address_type => "ATYPE_EXPLICIT_ADDRESS_EXPLICIT_PORT",
                ipport => $IPPortDefinition
        };
        my $MonitorRule = {
                type => "MONITOR_RULE_TYPE_SINGLE",
                quorum => 0,
                monitor_templates => [$monitor]
        };

        my $MonitorAssociation = {
                member => $MonitorIP,
                monitor_rule => $MonitorRule
        };
my (@MonitorAssociationA,@MonitorAssociationAofA);
  push @MonitorAssociationA, $MonitorAssociation;
  push @MonitorAssociationAofA, [@MonitorAssociationA];
  
  my $soapResponse = $PoolMember->set_monitor_association(
    SOAP::Data->name(pool_names => [$pool]),
    SOAP::Data->name(monitor_associations => [@MonitorAssociationAofA])
  );
  &checkResponse($soapResponse);
  
  &getPoolMemberMonitors($pool, $member);
  
}

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