#!/usr/bin/perl

=head1 NAME 

check_jmx4perl - Nagios check using jmx4perl for accessing JMX information 

=head1 SYNOPSIS 

 # Check used heap memory for absolute values
 check_jmx4perl --url http://localhost:8888/j4p \
                --name memory_used \
                --mbean java.lang:type=Memory \
                --attribute HeapMemoryUsage \ 
                --path used \
                --critical 10000000 \
                --warning   5000000 

 # Check used heap memory for absolute values by using an alias
 check_jmx4perl --url http://localhost:8888/j4p \
                --alias MEMORY_HEAP_USED \
                --critical 10000000 \
                --warning   5000000 

 # Check that the used heap memory is below 80% of the available memory
 check_jmx4perl --url http://localhost:8888/j4p \
                --alias MEMORY_HEAP_USED \
                --base-alias MEMORY_HEAP_MAX \ 
                --critical 0.8

 # Check that no more than 5 threads are started in a minute
 check_jmx4perl --url http://localhost:8888/j4p \
                --alias THREAD_COUNT_STARTED \
                --delta 60 \
                --critical 5

=head1 DESCRIPTION

Command for providing Nagios conformant output for JMX response fetched via
L<JMX::Jmx4Perl>. It knows about critical (via C<--critical>) and warning (via
C<--warning>) thresholds. 

C<--delta> switches on incremental mode in which the difference between two
following values is used. The optional argument are interpreted as seconds
which are used for calculating the speed of growth. If not given, only the
difference between the current and the latest value is taken.

=cut

use FindBin qw ($Bin);
use lib qq($Bin/../lib);
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use JMX::Jmx4Perl::Response;
use JMX::Jmx4Perl::Alias;
use strict;
use Data::Dumper;
use Nagios::Plugin;
use Time::HiRes qw(gettimeofday);
use Carp;

# Hack for avoiding a label in front of "OK" or "CRITICAL", in order to conform
# to the usual Nagios conventions
*Nagios::Plugin::Functions::get_shortname = sub {
    return undef;
};

my $np = Nagios::Plugin->
  new(
      usage => 
      "Usage: %s -u <agent-url> -m <mbean> -a <attribute> -c <threshold critical> -w <threshold warning> -n <label>\n" . 
      "                      [--alias <alias>] [--base-alias <alias>] [--user <user>] [--password <password>] [--product <product>] [-v] [--help]\n",
      version => "0.01",
      url => "http://www.consol.com/opensource/nagios/",
      plugin => "check_jmx4perl",
      blurb => "This plugin checks for JMX attribute values on a remote Java application server",
      extra => "\n\nYou need to deploy j4p.war on the target application server.\n" .
      "Please refer to the documentation for JMX::Jmx4Perl for further details"
     );
$np->shortname(undef);
$np->add_arg(
         spec => "url|u=s",
         help => "URL to agent web application (e.g. http://server:8080/j4p/)",
         required => 1
        );
$np->add_arg(
         spec => "product=s",
         help => "Name of app server product. \"jboss\")",
        );
$np->add_arg(
         spec => "alias=s",
         help => "Alias name for attribte (e.g. \"MEMORY_HEAP_USED\")",
        );
$np->add_arg(
         spec => "mbean|m=s",
         help => "MBean name (e.g. \"java.lang:type=Memory\")",
        );
$np->add_arg(
         spec => "attribute|a=s",
         help => "Attribute name (e.g. \"HeapMemoryUsage\")",
        );
$np->add_arg(
         spec => "base-alias|b=s",
         help => "Base alias name, which when given, interprets critical and warning values as relative",
        );
$np->add_arg(
         spec => "delta|d:s",
         help => "Switches on incremental mode. Optional argument are seconds used for normalizing. ",
        );
$np->add_arg(
         spec => "path|p=s",
         help => "Inner path for extracting a single value from a complex attribute (e.g. \"used\")",
        );
$np->add_arg(
         spec => "critical|c=s",
         help => "Critical Threshold for value. " . 
         "See http://nagiosplug.sourceforge.net/developer-guidelines.html#THRESHOLDFORMAT " .
         "for the threshold format.",
        );
$np->add_arg(
         spec => "user=s",
         help => "User for HTTP authentication"
        );
$np->add_arg(
         spec => "password=s",
         help => "Password for HTTP authentication"
        );
$np->add_arg(
         spec => "warning|w=s",
         help => "Warning Threshold for value.",
        );
$np->add_arg(
         spec => "verbose|v",
         help => "Print verbose output "
        );
$np->add_arg(
         spec => "name|n=s",
         help => "Name to use for output. Optional, by default a standard value based on the MBean ".
                 "and attribute will be used"
        );
$np->getopts();

&_verify_and_initialize($np);
my $o = $np->opts;

eval {
    my $o = $np->opts;

    # Request
    my $jmx = JMX::Jmx4Perl->new(mode => "agent", url => $o->url, user => $o->user, password => $o->password,
                                 ($o->product ? (product => $o->product) : ()));
    my $request = JMX::Jmx4Perl::Request->new(READ,&_prepare_request_args($np,$jmx));
    my $resp = &_send_request($np,$jmx,$request);
    my $value = $resp->value;

    # Delta handling
    my $delta = $o->get("delta");
    if (defined($delta)) {
        my $history = $resp->history;
        if (!$history) {
            &_switch_on_history($jmx,$request);           
            # No delta on the first run
            $value = 0;
        } else {
            my $old_value = $history->[0]->{value};
            my $old_time = $history->[0]->{timestamp};
            if ($delta) {
                $value = (($resp->value - $old_value) / ($resp->timestamp - $old_time)) * $delta;
            } else {
                $value = $resp->value - $old_value;
            }
        }
    }

    # Base value handling
    if ($o->get("base-alias")) {
        $request = new JMX::Jmx4Perl::Request(READ,$jmx->resolve_alias($o->get("base-alias")));
        $resp = &_send_request($np,$jmx,$request);
        $value = $value / $resp->value;
    };

    # Add Nagios perfdata
    $np->add_perfdata(label => &get_name($o),value => $value, critical => $o->critical, warning => $o->warning);

    # Verify thresholds
    my $code = $np->check_threshold($value);    
    $np->nagios_exit($code,&get_name($o). " : Threshold " . ($code == CRITICAL ? $o->critical : $o->warning) . 
                     " failed for value $value") if $code != OK;
    $np->nagios_exit(OK,&get_name($o) . " : $value in range");
};
if ($@) {
    $np->nagios_die("Error: $@");
}

sub get_name { 
    my $o = shift;
    if ($o->name) {
        return $o->name;
    } else {
        # Default name
        return $o->alias ? 
          "[".$o->alias.($o->path ? "," . $o->path : "") ."]" : 
          "[".$o->mbean.",".$o->attribute.($o->path ? "," . $o->path : "")."]";
    }
}

sub print_mbeans {
    my $resp = shift;
    
    
    print Dumper($resp->value);    
}


sub _send_request {
    my ($np,$jmx,$request) = @_;
    my $o = $np->opts;

    my $start_time;    
    if ($o->verbose) {
        print "Request URL: ",$jmx->request_url($request),"\n";
        if ($o->user) {
            print "Remote User: ",$o->user,"\n";
        }
        $start_time = (gettimeofday)[1];    
    }

    my $resp = $jmx->request($request);
    &_verify_response($np,$resp);

    if ($o->verbose) {
        my $duration = int ((gettimeofday)[1] - $start_time) / 1000;
        print "Result fetched in ",$duration,"ms:\n";
        print Dumper($resp);
    }

    return $resp;
}

sub _switch_on_history {
    my ($jmx,$orig_request) = @_;
    my ($mbean,$operation) = $jmx->resolve_alias(JMX4PERL_HISTORY_MAX_ATTRIBUTE);
    # Set history to 1 (we need only the last
    my $switch_request = new JMX::Jmx4Perl::Request(EXEC,$mbean,$operation,
                                     $orig_request->get("mbean"),$orig_request->get("attribute"),$orig_request->get("path"),1);
    my $resp = $jmx->request($switch_request);
    if ($resp->is_error) {
        $np->nagios_die("Error: ".$resp->status." ".$resp->error_text."\nStacktrace:\n".$resp->stacktrace);
    }

    # Refetch value to initialize the history
    $resp = $jmx->request($orig_request);
    &_verify_response($np,$resp);
}

sub _prepare_request_args {
    my $np = shift;
    my $jmx = shift;
    my $o = $np->opts;

    if ($o->alias) {
        my @req_args = $jmx->resolve_alias($o->alias);
        $np->nagios_die("Cannot resolve alias ",$o->alias()) unless @req_args > 0;
        if ($o->path) {
            @req_args == 2 ? $req_args[2] = $o->path : $req_args[2] .= "/" . $o->path;
        }
        return @req_args;
    } else {
        return ($o->mbean,$o->attribute,$o->path);
    }
}

sub _verify_response {
    my ($np,$resp) = @_;
    if ($resp->is_error) {
        $np->nagios_die("Error: ".$resp->status." ".$resp->error_text."\nStacktrace:\n".$resp->stacktrace);
    }
    if (!defined($resp->value)) {
        $np->nagios_die("JMX Request " . &get_name($o) . " failed" . Dumper($resp));
    }
    if (ref($resp->value)) { 
        $np->nagios_die("Response value is a ".ref($resp->value).
                        ", not a plain value. Did you forget a --path parameter ?","Value: " . Dumper($resp->value));
    }
}

sub _verify_and_initialize { 
    my $np = shift;
    my $o = $np->opts;

    $np->nagios_die("An MBean name and a attribute must be provided")
      if ((!$o->mbean && !$o->attribute) && !$o->alias);
    
    $np->nagios_die("At least a critical or warning threshold must be given") 
      if ((!defined($o->critical) && !defined($o->warning)));
    
    $np->set_thresholds
      (
       $o->critical ? (critical => $o->critical) : (),
       $o->warning ? (warning => $o->warning) : ()
      );    
}

=head1 LICENSE

This file is part of jmx4perl.

Jmx4perl 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.

jmx4perl 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 jmx4perl.  If not, see <http://www.gnu.org/licenses/>.

=head1 AUTHOR

roland@cpan.org

=cut
