Perl Set Monitor Property

Problem this snippet solves:

This perl sample illustrates how to use the LocalLB Monitor methods to get and set the properties for a Monitor Template.

Code :

#!/usr/bin/perl
#----------------------------------------------------------------------------
# The contents of this file are subject to the "END USER LICENSE AGREEMENT
# FOR F5 Software Development Kit for iControl"; you may not use this file 
# except in compliance with the License. The License is included in the 
# iControl Software Development Kit.
#
# 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-2009 
# 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;
use MIME::Base64;

BEGIN {push (@INC, "..");}
use iControlTypeCast;

#----------------------------------------------------------------------------
# Validate Arguments
#----------------------------------------------------------------------------
my $sHost = $ARGV[0];
my $sPort = $ARGV[1];
my $sUID = $ARGV[2];
my $sPWD = $ARGV[3];
my $sMonitor = $ARGV[4];
my $sProperty = $ARGV[5];
my $sValue = $ARGV[6];
my $sProtocol = "https";

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

sub usage()
{
  print "Usage: SetMonitorProperty.pl host port uid pwd [monitorname [StrPropertyType value]]\n";
  print "Example:\n";
  print "  .\\SetMonitorProperty.pl bigip 443 user pass my_http STYPE_RECEIVE foobar\n";
  exit();
}

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

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

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

#----------------------------------------------------------------------------
# Main Logic
#----------------------------------------------------------------------------
if ( "" eq $sMonitor )
{
  &getMonitorList();
}
elsif ( ("" eq $sProperty) || ("" eq $sValue) )
{
  &getMonitorInfo($sMonitor);
}
else
{
  &setMonitorProperty($sMonitor, $sProperty, $sValue);
}

#----------------------------------------------------------------------------
# sub getMonitorList()
#----------------------------------------------------------------------------
sub getMonitorList()
{
  $soapResponse = $Monitor->get_template_list();
  &checkResponse($soapResponse);

  print "HTTP Monitor Templates\n";
  print "----------------------\n";
  
  @MonitorTemplateA = @{$soapResponse->result};
  foreach $MonitorTemplate (@MonitorTemplateA)
  {
    $name = $MonitorTemplate->{"template_name"};
    $type = $MonitorTemplate->{"template_type"};
    
    if ( "TTYPE_HTTP" eq $type )
    {
      print "  $name\n";
    }
  }
}

#----------------------------------------------------------------------------
# sub getMonitorInfo()
#----------------------------------------------------------------------------
sub getMonitorInfo()
{
  my ($monitor) = (@_);
  $soapResponse = $Monitor->get_template_type(
    SOAP::Data->name(template_names => [$monitor])
  );
  &checkResponse($soapResponse);
  @TemplateTypeA = @{$soapResponse->result};
  $TemplateType = @TemplateTypeA[0];
  if ( "TTYPE_HTTP" eq $TemplateType )
  {
    push @Monitors, $monitor;
    push @Monitors, $monitor;
    push @Monitors, $monitor;
    push @Monitors, $monitor;
    
    push @PropertyTypes, "STYPE_SEND";
    push @PropertyTypes, "STYPE_RECEIVE";
    push @PropertyTypes, "STYPE_USERNAME";
    push @PropertyTypes, "STYPE_PASSWORD";
    
    $soapResponse = $Monitor->get_template_string_property(
      SOAP::Data->name(template_names => [@Monitors]),
      SOAP::Data->name(property_types => [@PropertyTypes])
    );
    &checkResponse($soapResponse);
    @StringValueA = @{$soapResponse->result};
    foreach $StringValue (@StringValueA)
    {
      $type = $StringValue->{"type"};
      $value = $StringValue->{"value"};
      print "  $type = $value\n";
    }
  }
  else
  {
    print "Monitor Template $monitor is not of type TTYPE_HTTP\n";
  }
}

#----------------------------------------------------------------------------
# sub setMonitorProperty()
#----------------------------------------------------------------------------
sub setMonitorProperty()
{
  my ($monitor, $property, $value) = (@_);
  
  
  $StringValue = {
    type => $property,
    value => $value
  };
  
  $soapResponse = $Monitor->set_template_string_property(
    SOAP::Data->name(template_names => [$monitor]),
    SOAP::Data->name(values => [$StringValue])
  );
  &checkResponse($soapResponse);
  
  &getMonitorInfo($monitor);
}


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