ldap Reporter

Problem this snippet solves:

The ldapReporter perl application (Codeshare entry: ) is a small server dedicated app that runs on the pool member1 and reports pool member ‘load’ to the database. Pool member load (weight) is calculated as

weight=1000-$currentConnections - $backlog10 - $waiters10;

and clamped to the range 0 - 1000 (Where 1000 = no load and 0 = fully loaded)

Itemslapd StatDescription
currentConnectionscurrentconnectionsNumber of connections to the pool member. This includes connections via BIG-IP and direct.
backlogrequest-que-backlogThe number of requests waiting to be processed by a thread
waitersreadwaitersNumber of connectionswhere some requests are pending and not currently being serviced by a thread in Directory Server.

These stats are all gathered from the slapd process using a search on the ‘cn=monitor’ base. The stats are presented to the database in the f5_poolmember table with the SQL

update f5_poolmember set dynamicratio=?,dnrsettime=? where ipaddr=? and portnum=?


dynamicratio=weight dnrsettime=current epoch time

ipaddr and portnum are provided on the commandline to ldapReporter. Once provided, the app sleeps again for an interval defined on the command line (The default interval is 60 seconds).

Note: Check out the companion article for more information (http://devcentral.f5.com/Tutorials/TechTips/tabid/63/articleType/ArticleView/articleId/1086439/Dynamic-Intelligent-Application-Delivery-in-a-Distributed-EnvironmentndashPart-2.aspx)

Code :

#!/usr/local/bin/perl -W

use Getopt::Std;

use Net::LDAP;

use POSIX; # qw(strftime);
use DBI;
use Time::gmtime();
use Data::Dumper;

use Sys::Hostname;

my $ldapServer = "localhost";
my $ldapPort = 389;
my $dbServer = "";

%sql_clause = (
  "upd_pm_ratio" => "update f5_poolmember set dynamicratio=?,dnrsettime=? where ipaddr=? and portnum=?"


sub dbprint {
 my $debug=1;

 if($debug>0) {
   my $thisiso=strftime("%Y%m%dT%H%M%SZ", gmtime(time));

   print "DEBUG: $$ : $thisiso : [$message]\n";


sub setWeight {
  my($weight, $pmip, $pmport)=@_;

  my $thisiso=strftime("%Y%m%dT%H%M%SZ", gmtime(time));

  dbprint "setting $pmip:$pmport => $weight, timestamp $thisiso";

  $sql_query{upd_pm_ratio}->execute($weight, $thisiso, $pmip, $pmport);

sub build_queries {
  my ($dbh)=(@_);

  foreach $query (keys %sql_clause) {
    dbprint "build_queries: Preparing [$query] => [$sql_clause{$query}]";
  dbprint "build_queries: done";

sub logAction {
 my ($action, $procName, $message)=@_;

 dbprint "logAction: [$action] [$procName] [$message]";
 $sql_query{upd_procst}->execute($action, 0, $procName);
 dbprint "logAction: finished";

# sleepuntil
sub sleepuntil {
  use Time::gmtime;

  # Sleep until a multiple of $_[0] seconds

  dbprint "sleepuntil: $sleeptime";


  my $mydelay=$sleeptime-($lt->sec % $sleeptime)+$random;

  sleep $mydelay;

sub checkLDAP {
  my($db, $ldapHost, $pmip, $pmport)=@_;

  my $connection = Net::LDAP->new( $ldapHost ) or die "$@";

  my $result = $connection->search(
                     base   => "cn=monitor",
                     scope  => "base",
                     filter => "(objectclass=*)",
                     attrs  => ["request-que-backlog", "currentconnections", "readwaiters"]
  if ($result->code) {
   print "**** ".$result->error." ****\n";
   print $result->error_text."\n";
  } else {
    if ( my $entry = $result->shift_entry ) {

      my $currentconnections = $entry->get_value("currentconnections");
      my $backlog = $entry->get_value("request-que-backlog");
      my $waiters = $entry->get_value("readwaiters");
      my $weight = 1000 - $currentconnections - $backlog*10 - $waiters*10;
      if ($weight < 0) {

      dbprint "weight: $weight - $currentconnections - $backlog - $waiters";

      setWeight($weight, $pmip, $pmport);

$debug=0;                       $debug=$opt_d if (defined $opt_d);
$myfqdn=$opt_m if(defined $opt_m);
my $rescanInterval=60;          $rescanInterval = $opt_t if(defined $opt_t);
my $dbhostname="";     $dbhostname=$opt_h if(defined $opt_h);
my $dbuser='ebmonitor';         $dbuser=$opt_u if(defined $opt_u);
my $dbpass='';                  $dbpass=$opt_p if(defined $opt_p);
my $ldaphost='';       $ldaphost=$opt_l if(defined $opt_l);
my $target="";                  $target=$opt_q if(defined $opt_q);

if($target eq "") {
  dbprint "Must specify a poolmember IP:Port with -q ";

my($pmip,$pmport)=split(/:/, $target);
dbprint "split $target => ($pmip) ($pmport)";

my $dbh = DBI->connect( "dbi:mysql:monitor:$dbhostname", $dbuser, $dbpass , {
  AutoCommit => 0,
  RaiseError => 1,
} );



while(1) {

  checkLDAP($dbh, $ldaphost, $pmip, $pmport);
Updated Jun 06, 2023
Version 2.0

Was this article helpful?

No CommentsBe the first to comment