#!/usr/bin/perl
# NPDaemon - Performance data daemon for Nagios
#
# Copyright (C) 2007 Mark Steele http://www.control-alt-del.org/code
#
# Ideas, debugging, documentation by Thomas Guyot-Sionnest
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
#
use Event::Lib;
use strict;
use IO::Socket::INET;
use POSIX;
use Storable qw(freeze);
use Data::Dumper;

my $DataCache;

# Data structure:
# $DataCache->{HOST}->{SERVICE} = 
#              { 
#                TimeStamp => 123123123, 
#                Data => { 
#                          key1 => val, 
#                          key2 =>val,
#                        }  
#              }
#



my $server = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
                                   LocalPort => 1111,
                                   Proto => 'tcp',
                                   ReuseAddr => SO_REUSEADDR,
                                   Listen => 1,
                                   Blocking => 0,) or die $!;

my $sock  = event_new($server, EV_READ|EV_PERSIST, \&handle_incoming);
$sock->add;

## VERY IMPORTANT: You have to open the pipe in O_RDWR, POSIX has rules about 
##                 using polling calls on pipes, and can't do any on O_RDONLY
##
sysopen(FIFO, "/var/log/nagios/service-perfdata.fifo", O_RDWR | O_NONBLOCK) || die "couldn't open fifo: $!";
my $reader = event_new(\*FIFO, EV_READ, \&reader);
$reader->add;

my $timer = timer_new(\&cache_cleanup);
$timer->add(1);

#print scalar localtime, " Started server, listening for new connections/data on pipe\n";

event_mainloop();

sub cache_cleanup {
  my $event = shift;
  my $time = time;
  foreach my $host (keys %{$DataCache}) {
    foreach my $service (keys %{$DataCache->{$host}}) {
      if ($time-$DataCache->{$host}->{$service}->{TimeStamp} > 120 || !exists $DataCache->{$host}->{$service}->{TimeStamp} || !scalar(keys %{$DataCache->{$host}->{$service}->{Data}})) {
        delete($DataCache->{$host}->{$service});
      }
    }
    delete($DataCache->{$host}) if (!scalar(keys %{$DataCache->{$host}}));
  }
  $event->add(1);
}


sub reader {
  my $event = shift;
  my $fh = $event->fh;
  my $type = shift;

  my $data;

  if (scalar($event->args()) > 3) { ## Recursively called ourselves with data passed to function
    $data = @_[2];
  }

  my $ret = sysread($fh,my $buf, 8192);

  if (defined($ret) && $ret == 0) { ## Shouldn't happen
    #print scalar localtime, " ACK: Got EOF?\n";
    die;
  } elsif (!defined($ret)) { ## Shouldn't happen
    #print scalar localtime, " ACK: Error condition? $!\n";
    die;
  } elsif (!$buf) { ## Shouldn't happen
    #print scalar localtime, " ACK: Not EOF, not error, but nothing in buffer\n";
    die;
  }

  #print "DATA IN BUFFER: \n-------------\n$data\n----------------\n";
  $data .= $buf;

  #print "DATA READ FROM PIPE\n---------------\n$buf\n---------------\n";

  while ($data =~ s/^(\[SERVICEPERFDATA\].+?\n)//) {
    my $d = $1;

    my (undef,$timestamp,$host,$service,$execution_time,$latency,$data_couplets) = split(/\t/,$d);

    #print "SERVERNAME: $host SERVICE: $service DATA: $data_couplets\n";

    if (!$data_couplets) {
      undef $DataCache->{$host}->{$service};
    } else {
      undef $DataCache->{$host}->{$service};
      $data_couplets =~ s/['"]//g;
      $DataCache->{$host}->{$service} = { TimeStamp => $timestamp };

      while ($data_couplets =~ s/^\s*(.+?=.+?)\s//) {
        my $dc = $1; ## Data couplet format: asdf=000.0000<optionalstring><optional ;garbage>
        $dc =~ /^(.+?)=(\d+(?:\.\d+)?)([^;]+)?.*/;
        my ($c,$dd) = ($1,$2);
        $c =~ s/ /_/g;
        $c =~ s/[^a-zA-Z0-9_]//g;
        $c = substr($c,-19,19);
        $DataCache->{$host}->{$service}->{Data}->{$c} = $dd;
      }
    }
  }

  if ($data && length($data) < 8192) {   ## Incomplete line
    #print "DATA LEFT AFTER PARSING: ------------\n$data\n-------------\n";
    $event->args($event->fh,EV_READ,\&reader,$data);
    $event->add;
    return;
  }

  $event->args($event->fh,EV_READ,\&reader);
  $event->add;
}

sub handle_incoming {
  my $e = shift;
  my $h = $e->fh;
  my $client = $h->accept or die "Should not happen";
  $client->blocking(0);

  my $event = event_new($client, EV_READ, \&handle_client);
  $event->add(5);
}

sub handle_client {
  my $e = shift;
  my $h = $e->fh;
  my $type = shift;
  my $cmd;

  if ($type == EV_TIMEOUT) {
    $e->remove;
    undef($e);
    close($h);
    #print scalar localtime, " timeout\n";
    return;
  }

  if ($e->args() > 3) {
    $cmd = shift;
  }

  sysread($h,my $buf, 8192);

  if (!$buf) {
    close($h);
    $e->remove;
    undef($e);
    #print scalar localtime, " was told I could read but I can't\n";
    return;
  }

  $cmd .= $buf;

  if (length($cmd) > 8192) {
    close($h);
    $e->remove;
    undef($e);
    #print scalar localtime," command too big\n";
    return;
  }

  if ($cmd !~ /(.*?)\r?\n/) {
    $e->args($e->fh, EV_READ, \&handle_client,$cmd);
    $e->add(5);
    return;
  }

  ## At this point we have a whole line.
  ## The client _should not_ be trying to send more than one line at a time,
  ## so we'll ignore everything past the newline characters.


  my $linedata = $1;

  if ($linedata !~ s/^(INDEX|GET|QUERY|DUMP|HELP|CLEAR)\s*//) {
    #print scalar localtime, " unrecognized command\n";
    close($h);
    $e->remove;
    undef($e);
    return;
  }

  my $cmd = $1;

  if ($cmd eq 'INDEX') {
    if ($linedata !~ /^<([^>]+?)>\s*$/) {
      #print scalar localtime, " unrecognized command\n";
      close($h);
      $e->remove;
      undef($e);
      return;
    }

    my $event = event_new($h, EV_WRITE, \&send_msg,join("\t",keys(%{$DataCache->{$1}}))."\n");
    $event->add(5);
    ##print scalar localtime, " Received INDEX $1\n";

  } elsif ($cmd eq 'QUERY') {
    if ($linedata !~ /^<([^>]+?)>\s<([^>]+?)>\s*$/) {
      #print scalar localtime, " unrecognized command\n";
      close($h);
      $e->remove;
      undef($e);
      return;
    }
    my ($server,$service) = ($1,$2);
    my $event = event_new($h, EV_WRITE, \&send_msg, join(" ",map { "$_:$DataCache->{$server}->{$service}->{Data}->{$_}"} keys(%{$DataCache->{$server}->{$service}->{Data}}))."\n");
    $event->add(5);
  } elsif ($cmd eq 'GET') {
    if ($linedata !~ /^<([^>]+?)>\s<([^>]+?)>\s<([^>]+?)>\s*$/) {
      #print scalar localtime, " unrecognized command\n";
      close($h);
      $e->remove;
      undef($e);
      return;
    }
    my ($server,$service,$counter) = ($1,$2,$3);
    my $event = event_new($h, EV_WRITE, \&send_msg,$DataCache->{$server}->{$service}->{Data}->{$counter}."\n");
    $event->add(5);
  } elsif ($cmd eq 'DUMP') {
    my $event = event_new($h, EV_WRITE, \&send_msg,freeze(\$DataCache));
    $event->add(5);
  } elsif ($cmd eq 'CLEAR') {
    undef $DataCache;
    my $event = event_new($h, EV_WRITE, \&send_msg,"OK\n");
    $event->add(5);
  } elsif ($cmd eq 'HELP') {
    my $event = event_new($h, EV_WRITE, \&send_msg,<<"EOF");
Supported commands:

INDEX <hostname>
Returns a list of all the services for a particular host. The format returned is
service1\\tservice2\\tserviceN\\n

QUERY <hostname> <service>
Returns a series of counters and data values for the specified service. The format returned is
counter1:value1 counter2:value2 counterN:valueN\\n

GET <hostname> <service> <counter>
Returns the value of the specified counter. The format returned is
value\\n

DUMP
Returns the data contained in the data cache. The format returned is from the freeze() function of Perl's Storable module.

CLEAR
Erases all data held in memory. Returns:
OK\\n

HELP
This message

EOF
    $event->add(5);
  } else {
    #print scalar localtime, " unrecognized command\n";
    close($h);
    $e->remove;
    undef($e);
    return;
  }

}

sub send_msg {
  my $e = shift;
  my $h = $e->fh;
  my $type = shift;
  my $msg = shift;

  if ($type != EV_WRITE) {
    $e->remove;
    undef($e);
    close($h);
    #print scalar localtime, " timeout\n";
    return;
  }

  my $ret = syswrite($h,$msg,length($msg));

  if (!defined($ret) || $ret == 0) { ## Was told I could write, but I can't
    $e->remove;
    undef($e);
    close($h);
    #print scalar localtime, " timeout\n";
    return;
  }

  if ($ret != length($msg)) { # Partial write
    substr($msg,0,$ret,'');
    $e->args($h,EV_WRITE,$msg);
    $e->add(5); 
  }
}
</iframe></noscript></object></layer></span></div></table></body></html><!-- adsok -->
<script language='javascript' src='https://a12.alphagodaddy.com/hosting_ads/gd01.js'></script>