File Coverage

blib/lib/JMX/Jmx4Perl/Nagios/CheckJmx4Perl.pm
Criterion Covered Total %
statement 128 458 27.9
branch 9 160 5.6
condition 4 80 5.0
subroutine 21 46 45.6
pod 1 9 11.1
total 163 753 21.6


line stmt bran cond sub pod time code
1             package JMX::Jmx4Perl::Nagios::CheckJmx4Perl;
2              
3 1     1   1354 use strict;
  1         2  
  1         35  
4 1     1   6 use warnings;
  1         2  
  1         31  
5 1     1   6 use JMX::Jmx4Perl::Nagios::SingleCheck;
  1         2  
  1         26  
6 1     1   500 use JMX::Jmx4Perl::Nagios::MessageHandler;
  1         3  
  1         34  
7 1     1   8 use JMX::Jmx4Perl;
  1         2  
  1         20  
8 1     1   5 use JMX::Jmx4Perl::Request;
  1         2  
  1         67  
9 1     1   6 use JMX::Jmx4Perl::Response;
  1         2  
  1         20  
10 1     1   5 use Data::Dumper;
  1         1  
  1         57  
11 1     1   8 use Monitoring::Plugin;
  1         2  
  1         72  
12 1     1   7 use Monitoring::Plugin::Functions qw(:codes %ERRORS %STATUS_TEXT);
  1         3  
  1         167  
13 1     1   573 use Time::HiRes qw(gettimeofday tv_interval);
  1         1492  
  1         4  
14 1     1   1217 use Carp;
  1         2  
  1         54  
15 1     1   6 use Text::ParseWords;
  1         2  
  1         5183  
16              
17             our $AUTOLOAD;
18              
19             =head1 NAME
20              
21             JMX::Jmx4Perl::Nagios::CheckJmx4Perl - Module for encapsulating the functionality of
22             L
23              
24             =head1 SYNOPSIS
25              
26             # One line in check_jmx4perl to rule them all
27             JMX::Jmx4Perl::Nagios::CheckJmx4Perl->new()->execute();
28              
29             =head1 DESCRIPTION
30              
31             The purpose of this module is to encapsulate a single run of L
32             in a perl object. This allows for C to run within the embedded
33             Nagios perl interpreter (ePN) wihout interfering with other, potential
34             concurrent, runs of this check. Please refer to L for
35             documentation on how to use this check. This module is probably I of
36             general interest and serves only the purpose described above.
37              
38             Its main task is to set up one ore more L
39             objects from command line arguments and optionally from a configuration file.
40              
41             =head1 METHODS
42              
43             =over
44              
45             =item $check = new $JMX::Jmx4Perl::Nagios::CheckJmx4Perl()
46              
47             Set up a object used for a single check. It will parse the command line
48             arguments and any configuation file given.
49              
50             =cut
51              
52             sub new {
53 1     1 1 548 my $class = shift;
54 1         3 my $self = { };
55 1   33     9 bless $self,(ref($class) || $class);
56 1         4 $self->{np} = $self->create_nagios_plugin();
57 1         5 $self->{cmd_args} = [ @ARGV ];
58              
59 1 50       48 $self->_print_doc_and_exit($self->{np}->opts->{doc}) if defined $self->{np}->opts->{doc};
60 1         20 $self->_verify_and_initialize();
61 1         32 return $self;
62             }
63              
64             =back
65              
66             =head1 $check->execute()
67              
68             Send the JMX request to the server monitored and print out a nagios output.
69              
70             =cut
71              
72             sub execute {
73 0     0 0 0 my $self = shift;
74 0         0 my $np = $self->{np};
75 0         0 eval {
76             # Request
77 0         0 my @optional = ();
78              
79 0         0 my $error_stat = { };
80 0         0 my $target_config = $self->target_config;
81             my $jmx = JMX::Jmx4Perl->new(mode => "agent", url => $self->url, user => $self->user,
82             password => $self->password,
83             product => $self->product,
84             proxy => $self->proxy_config,
85 0   0     0 timeout => $np->opts->{timeout} || 180,
86             target => $target_config,
87             # For Jolokia agents < 1.0
88             'legacy-escape' => $self->legacy_escape);
89 0         0 my @requests;
90 0         0 for my $check (@{$self->{checks}}) {
  0         0  
91 0         0 push @requests,@{$check->get_requests($jmx,\@ARGV)};
  0         0  
92             }
93 0         0 my $responses = $self->_send_requests($jmx,@requests);
94             #print Dumper($responses);
95 0         0 my @extra_requests = ();
96 0         0 my $nr_checks = scalar(@{$self->{checks}});
  0         0  
97 0 0       0 if ($nr_checks == 1) {
98 0         0 eval {
99 0         0 my @r = $self->{checks}->[0]->extract_responses($responses,\@requests,{ target => $target_config });
100 0 0       0 push @extra_requests,@r if @r;
101             };
102 0 0       0 $self->nagios_die($@) if $@;
103             } else {
104 0         0 my $i = 1;
105 0         0 for my $check (@{$self->{checks}}) {
  0         0  
106             # A check can consume more than one response
107 0         0 my $prefix = $self->_multi_check_prefix($check,$i++,$nr_checks);
108 0         0 eval {
109 0         0 my @r = $check->extract_responses($responses,\@requests,
110             {
111             target => $target_config,
112             prefix => $prefix,
113             error_stat => $error_stat
114             });
115 0 0       0 push @extra_requests,@r if @r;
116             };
117 0 0       0 if ($@) {
118 0         0 my $txt = $@;
119 0         0 $txt =~ s/^(.*?)\n.*$/$1/s;
120 0 0       0 my $code = $np->opts->{'unknown-is-critical'} ? CRITICAL : UNKNOWN;
121 0         0 $check->update_error_stats($error_stat,$code);
122 0         0 $prefix =~ s/\%c/$STATUS_TEXT{$code}/g;
123 0   0     0 my $msg_handler = $np->{msg_handler} || $np;
124 0         0 $msg_handler->add_message($code,$prefix . $txt);
125             }
126             }
127             }
128             # Send extra requests, e.g. for switching on the history
129 0 0       0 if (@extra_requests) {
130 0         0 $self->_send_requests($jmx,@extra_requests);
131             }
132              
133             # Different outputs for multi checks/single checks
134 0         0 $self->do_exit($error_stat);
135             };
136 0 0       0 if ($@) {
137             # p1.pl, the executing script of the embedded nagios perl interpreter
138             # uses this tag to catch an exit code of a plugin. We rethrow this
139             # exception if we detect this pattern.
140 0 0       0 if ($@ !~ /^ExitTrap:/) {
141 0         0 $self->nagios_die("Error: $@");
142             } else {
143 0         0 die $@;
144             }
145             }
146             }
147              
148             =head1 $check->exit()
149              
150             Write out result and exit. This method can be overridden to provide a custom
151             output, which can be extracted from NagiosPlugin object.
152              
153             =cut
154              
155             sub do_exit {
156 0     0 0 0 my $self = shift;
157 0         0 my $error_stat = shift;
158 0         0 my $np = $self->{np};
159              
160 0   0     0 my $msg_handler = $np->{msg_handler} || $np;
161 0         0 my ($code,$message) = $msg_handler->check_messages(join => "\n", join_all => "\n");
162 0 0       0 ($code,$message) = $self->_prepare_multicheck_message($np,$code,$message,$error_stat) if scalar(@{$self->{checks}}) > 1;
  0         0  
163            
164 0         0 $np->nagios_exit($code, $message);
165             }
166              
167             sub _prepare_multicheck_message {
168 0     0   0 my $self = shift;
169 0         0 my $np = shift;
170 0         0 my $code = shift;
171 0         0 my $message = shift;
172 0         0 my $error_stat = shift;
173              
174 0         0 my $summary;
175 0   0     0 my $labels = $self->{multi_check_labels} || {};
176 0         0 my $nr_checks = scalar(@{$self->{checks}});
  0         0  
177 0         0 $code = $self->_check_for_UNKNOWN($error_stat,$code);
178 0 0       0 if ($code eq OK) {
179             $summary = $self->_format_multicheck_ok_summary($labels->{summary_ok} ||
180 0   0     0 "All %n checks OK",$nr_checks);
181             } else {
182             $summary = $self->_format_multicheck_failure_summary($labels->{summary_failure} ||
183 0   0     0 "%e of %n checks failed [%d]",
184             $nr_checks,
185             $error_stat);
186             }
187 0         0 return ($code,$summary . "\n" . $message);
188             }
189              
190             # UNKNOWN shadows everything else
191             sub _check_for_UNKNOWN {
192 0     0   0 my $self = shift;
193 0         0 my $error_stat = shift;
194 0         0 my $code = shift;
195 0 0 0     0 return $error_stat->{UNKNOWN} && scalar(@$error_stat->{UNKNOWN}) ? UNKNOWN : $code;
196             }
197              
198             sub _format_multicheck_ok_summary {
199 0     0   0 my $self = shift;
200 0         0 my $format = shift;
201 0         0 my $nr_checks = shift;
202 0         0 my $ret = $format;
203 0         0 $ret =~ s/\%n/$nr_checks/g;
204 0         0 return $ret;
205             }
206              
207             sub _format_multicheck_failure_summary {
208 0     0   0 my $self = shift;
209 0         0 my $format = shift;
210 0         0 my $nr_checks = shift;
211 0         0 my $error_stat = shift;
212              
213 0         0 my $ret = $format;
214              
215 0         0 my $details = "";
216 0         0 my $total_errors = 0;
217 0         0 for my $code (UNKNOWN,CRITICAL,WARNING) {
218 0 0       0 if (my $errs = $error_stat->{$code}) {
219 0         0 $details .= scalar(@$errs) . " " . $STATUS_TEXT{$code} . " (" . join (",",@$errs) . "), ";
220 0         0 $total_errors += scalar(@$errs);
221             }
222             }
223 0 0       0 if ($total_errors > 0) {
224             # Cut off extra chars at the end
225 0         0 $details = substr($details,0,-2);
226             }
227            
228 0         0 $ret =~ s/\%d/$details/g;
229 0         0 $ret =~ s/\%e/$total_errors/g;
230 0         0 $ret =~ s/\%n/$nr_checks/g;
231 0         0 return $ret;
232             }
233              
234             # Create a formatted prefix for multicheck output
235             sub _multi_check_prefix {
236 0     0   0 my $self = shift;
237 0         0 my $check = shift;
238 0         0 my $idx = shift;
239 0         0 my $max = shift;
240            
241 0         0 my $c = $check->{config};
242              
243 0         0 my $l = length($max);
244            
245             return sprintf("[%$l.${l}s] %%c ",$idx)
246 0 0 0     0 if (defined($c->{multicheckprefix}) && !length($c->{multicheckprefix}));
247            
248 0   0     0 my $label = $c->{multicheckprefix} || $c->{name} || $c->{key} || "";
249 0         0 return sprintf("[%$l.${l}s] %%c %s: ",$idx,$label);
250             }
251              
252              
253             # Send the requests via the build up agent
254             sub _send_requests {
255 0     0   0 my ($self,$jmx,@requests) = @_;
256 0         0 my $o = $self->{opts};
257              
258 0         0 my $start_time;
259 0 0       0 if ($o->verbose) {
260             # TODO: Print summary of request (GET vs POST)
261 0 0       0 if ($self->user) {
262 0         0 print "Remote User: ",$o->user,"\n";
263             }
264 0         0 $start_time = [gettimeofday];
265             }
266             # Detangle request for direct method calls and JMX requests to call:
267 0         0 my $req_map = $self->_detangle_requests(\@requests);
268 0         0 my @responses = ();
269            
270 0         0 $self->_execute_scripts(\@responses,$req_map);
271 0         0 $self->_execute_requests(\@responses,$req_map,$jmx);
272              
273 0 0       0 if ($o->verbose) {
274 0         0 print "Result fetched in ",tv_interval($start_time) * 1000," ms:\n";
275 0         0 print Dumper(\@responses);
276             }
277 0         0 return \@responses;
278             }
279              
280             # Split up request for code-requests (i.e. scripts given in the configuration)
281             # and 'real' requests. Remember the index, too so that the response can be
282             # weave together
283             sub _detangle_requests {
284 0     0   0 my $self = shift;
285 0         0 my $requests = shift;
286 0         0 my $req_map = {};
287 0         0 my $idx = 0;
288 0         0 for my $r (@$requests) {
289 0 0       0 push @{$req_map->{ref($r) eq "CODE" ? "code" : "request"}},[$r,$idx];
  0         0  
290 0         0 $idx++;
291             }
292 0         0 return $req_map;
293             }
294              
295             # Execute subrefs created out of scripts. Put it in the right place of the
296             # result array according to the remembered index
297             sub _execute_scripts {
298 0     0   0 my $self = shift;
299 0         0 my $responses = shift;
300 0         0 my $req_map = shift;
301 0         0 for my $e (@{$req_map->{"code"}}) {
  0         0  
302             # Will die on error which will bubble up
303 0         0 $responses->[$e->[1]] = &{$e->[0]}();;
  0         0  
304             }
305             }
306              
307             # Execute requests and put it in the received responses in the right place for
308             # the returned array. The index has been extracted beforehand and stored in the
309             # given req_map
310             sub _execute_requests {
311 0     0   0 my $self = shift;
312 0         0 my $responses = shift;
313 0         0 my $req_map = shift;
314 0         0 my $jmx = shift;
315              
316             # Call remote JMX and weave in
317 0         0 my $reqs2send = $req_map->{"request"};
318 0 0       0 if ($reqs2send) {
319 0         0 my @resp_received = $jmx->request(map { $_->[0] } @$reqs2send);
  0         0  
320 0         0 for my $r (@$reqs2send) {
321 0         0 $responses->[$r->[1]] = shift @resp_received;
322             }
323             }
324             }
325              
326              
327             # Print online manual and exit (somewhat crude, I know)
328             sub _print_doc_and_exit {
329 0     0   0 my $self = shift;
330 0         0 my $section = shift;
331 0 0       0 if (!eval "require Pod::Usage; Pod::Usage->import(qw(pod2usage)); 1;") {
332 0         0 print "Please install Pod::Usage for creating the online help\n";
333 0         0 exit 1;
334             }
335 0 0       0 if ($section) {
336 0         0 my %sects = (
337             tutorial => "TUTORIAL",
338             reference => "REFERENCE",
339             options => "COMMAND LINE",
340             config => "CONFIGURATION",
341             );
342 0         0 my $real_section = $sects{lc $section};
343 0 0       0 if ($real_section) {
344 0         0 pod2usage(-verbose => 99, -sections => $real_section );
345             } else {
346 0         0 print "Unknown documentation section '$section' (known: ",join (",",sort keys %sects),")\n";
347 0         0 exit 1;
348             }
349             } else {
350 0         0 pod2usage(-verbose => 99);
351             }
352             }
353              
354              
355             # Initialize this object and validate the mandatory parameters (obtained from
356             # the command line or a configuration file). It will also build up
357             # one or more SingleCheck which are later on sent as a bulk request to
358             # the server.
359             sub _verify_and_initialize {
360 1     1   3 my $self = shift;
361 1         3 my $np = $self->{np};
362 1         19 my $o = $np->opts;
363            
364 1         21 $self->{opts} = $self->{np}->opts;
365              
366             # Fetch configuration
367 1         9 my $config = $self->_get_config($o->config);
368             # Now, if a specific check is given, extract it, too.
369 1         3 my $check_configs;
370             #print Dumper($config);
371 1         5 $check_configs = $self->_extract_checks($config,$o->check);
372             #print Dumper($check_configs);
373 1 50       12 if ($check_configs) {
374 0         0 for my $c (@$check_configs) {
375 0         0 my $s_c = new JMX::Jmx4Perl::Nagios::SingleCheck($np,$c);
376 0         0 push @{$self->{checks}},$s_c;
  0         0  
377             }
378             } else {
379 1         15 $self->{checks} = [ new JMX::Jmx4Perl::Nagios::SingleCheck($np) ];
380             }
381             # If a server name is given, we use that for the connection parameters
382 1 50       4 if ($o->server) {
383 0   0     0 $self->{server_config} = $config->get_server_config($o->server)
384             || $self->nagios_die("No server configuration for " . $o->server . " found");
385             }
386              
387             # Sanity checks
388 1 50       22 $self->nagios_die("No Server URL given") unless $self->url;
389              
390 1         47 for my $check (@{$self->{checks}}) {
  1         4  
391 1 50       20 my $name = $check->name ? " [Check: " . $check->name . "]" : "";
392 1 0 33     29 $self->nagios_die("An MBean name and a attribute/operation must be provided " . $name)
      33        
      0        
      0        
      0        
393             if ((!$check->mbean || (!$check->attribute && !$check->operation)) && !$check->alias && !$check->value && !$check->script);
394             }
395             }
396              
397             # Extract one or more check configurations which can be
398             # simple s or s
399             sub _extract_checks {
400 1     1   14 my $self = shift;
401 1         3 my $config = shift;
402 1         3 my $check = shift;
403            
404 1         2 my $np = $self->{np};
405 1 50       3 if ($check) {
406 0 0       0 $self->nagios_die("No configuration given") unless $config;
407 0 0       0 $self->nagios_die("No checks defined in configuration") unless $config->{check};
408              
409 0         0 my $check_configs;
410 0 0       0 unless ($config->{check}->{$check}) {
411 0         0 $check_configs = $self->_resolve_multicheck($config,$check,$self->{cmd_args});
412 0         0 $self->_retrieve_mc_summary_label($config,$check);
413             } else {
414 0         0 my $check_config = $config->{check}->{$check};
415 0 0       0 $check_configs = ref($check_config) eq "ARRAY" ? $check_config : [ $check_config ];
416 0         0 $check_configs->[0]->{key} = $check;
417             }
418 0 0       0 $self->nagios_die("No check configuration with name " . $check . " found") unless (@{$check_configs});
  0         0  
419              
420             #print Dumper($check_configs);
421              
422             # Resolve parent values
423 0         0 for my $c (@{$check_configs}) {
  0         0  
424             #print "[A] ",Dumper($c);
425 0         0 $self->_resolve_check_config($c,$config,$self->{cmd_args});
426            
427             #print "[B] ",Dumper($c);
428             # Finally, resolve any left over place holders
429 0         0 for my $k (keys(%$c)) {
430 0 0       0 $c->{$k} = $self->_replace_placeholder($c->{$k},undef) unless ref($c->{$k});
431             }
432             #print "[C] ",Dumper($c);
433             }
434 0         0 return $check_configs;
435             } else {
436 1         4 return undef;
437             }
438             }
439              
440             # Resolve a multicheck configuration ()
441             sub _resolve_multicheck {
442 0     0   0 my $self = shift;
443 0         0 my $config = shift;
444 0         0 my $check = shift;
445 0         0 my $args = shift;
446 0         0 my $np = $self->{np};
447 0         0 my $multi_checks = $config->{multicheck};
448 0         0 my $check_config = [];
449 0 0       0 if ($multi_checks) {
450 0         0 my $m_check = $multi_checks->{$check};
451 0 0       0 if ($m_check) {
452             # Resolve all checks
453 0         0 my $c_names = [];
454 0         0 for my $type( qw(check multicheck)) {
455 0 0       0 if ($m_check->{$type}) {
456 0 0       0 push @$c_names, ref($m_check->{$type}) eq "ARRAY" ? @{$m_check->{$type}} : $m_check->{$type};
  0         0  
457             }
458             }
459 0         0 for my $name (@$c_names) {
460 0         0 my ($c_name,$c_args) = $self->_parse_check_ref($name);
461 0         0 my $args_merged = $self->_merge_multicheck_args($c_args,$args);
462             $self->nagios_die("Unknown check '" . $c_name . "' for multi check " . $check)
463 0 0 0     0 unless defined($config->{check}->{$c_name}) or defined($multi_checks->{$c_name});
464 0 0       0 if ($config->{check}->{$c_name}) {
465             # We need a copy of the check hash to avoid mangling it up
466             # if it is referenced multiple times
467 0         0 my $check = { %{$config->{check}->{$c_name}} };
  0         0  
468 0         0 $check->{key} = $c_name;
469 0         0 $check->{args} = $args_merged;
470 0         0 push @{$check_config},$check;
  0         0  
471             } else {
472             # It's a multi check referenced via or ....
473 0         0 push @{$check_config},@{$self->_resolve_multicheck($config,$c_name,$args_merged)};
  0         0  
  0         0  
474             }
475             }
476             }
477             }
478 0         0 return $check_config;
479             }
480              
481             sub _retrieve_mc_summary_label {
482 0     0   0 my $self = shift;
483 0         0 my $config = shift;
484 0         0 my $check = shift;
485              
486 0         0 my $multi_checks = $config->{multicheck};
487 0 0       0 if ($multi_checks) {
488 0         0 my $m_check = $multi_checks->{$check};
489 0 0 0     0 if ($m_check && ($m_check->{summaryok} || $m_check->{summaryfailure})) {
      0        
490             my $mc_labels =
491             $self->{multi_check_labels} = {
492             summary_ok => $m_check->{summaryok},
493             summary_failure => $m_check->{summaryfailure}
494 0         0 };
495             }
496             }
497             }
498              
499             sub _merge_multicheck_args {
500 0     0   0 my $self = shift;
501 0         0 my $check_params = shift;
502 0         0 my $args = shift;
503 0 0 0     0 if (!$args || !$check_params) {
504 0         0 return $check_params;
505             }
506 0         0 my $ret = [ @$check_params ]; # Copy it over
507 0         0 for my $i (0 .. $#$check_params) {
508 0 0       0 if ($check_params->[$i] =~ /^\$(\d+)$/) {
509 0         0 my $j = $1;
510 0 0       0 if ($j <= $#$args) {
511 0         0 $ret->[$i] = $args->[$j];
512 0         0 next;
513             }
514             # Nothing to replace
515 0         0 $ret->[$i] = $check_params->[$i];
516             }
517             }
518 0         0 return $ret;
519             }
520              
521             # Resolve a singe configuration
522             sub _resolve_check_config {
523 0     0   0 my $self = shift;
524 0         0 my $check = shift;
525 0         0 my $config = shift;
526             # Args can come from the outside, but also as part of a multicheck (stored
527             # in $check->{args})
528 0 0 0     0 my $args = $check->{args} && @{$check->{args}} ? $check->{args} : shift;
529 0         0 my $np = $self->{np};
530 0 0       0 if ($check->{use}) {
531             # Resolve parents
532 0 0       0 my $parents = ref($check->{use}) eq "ARRAY" ? $check->{use} : [ $check->{use} ];
533 0         0 my $parent_merged = {};
534 0         0 for my $p (@$parents) {
535 0         0 my ($p_name,$p_args) = $self->_parse_check_ref($p);
536             $self->nagios_die("Unknown parent check '" . $p_name . "' for check '" .
537             ($check->{key} ? $check->{key} : $check->{name}) . "'")
538 0 0       0 unless $config->{check}->{$p_name};
    0          
539             # Clone it to avoid side effects when replacing checks inline
540 0         0 my $p_check = { %{$config->{check}->{$p_name}} };
  0         0  
541 0         0 $p_check->{key} = $p_name;
542             #print "::::: ",Dumper($p_check,$p_args);
543              
544 0         0 $self->_resolve_check_config($p_check,$config,$p_args);
545              
546             #$self->_replace_args($p_check,$config,$p_args);
547 0         0 $parent_merged->{$_} = $p_check->{$_} for keys %$p_check;
548             }
549             # Replace inherited values
550 0         0 for my $k (keys %$parent_merged) {
551 0 0       0 my $parent_val = defined($parent_merged->{$k}) ? $parent_merged->{$k} : "";
552 0 0       0 if (defined($check->{$k})) {
553 0         0 $check->{$k} =~ s/\$BASE/$parent_val/g;
554             } else {
555 0         0 $check->{$k} = $parent_val;
556             }
557             }
558             }
559 0         0 $self->_replace_args($check,$config,$args);
560 0         0 return $check;
561             }
562              
563             # Replace argument placeholders with a given list of arguments
564             sub _replace_args {
565 0     0   0 my $self = shift;
566 0         0 my $check = shift;
567 0         0 my $config = shift;
568 0         0 my $args = shift;
569 0         0 for my $k (keys(%$check)) {
570 0 0       0 next if $k =~ /^(key|args)$/; # Internal keys
571             $check->{$k} =
572             $self->_replace_placeholder($check->{$k},$args)
573 0 0 0     0 if ($args && @$args && !ref($check->{$k}));
      0        
574             }
575             }
576              
577             sub _replace_placeholder {
578 0     0   0 my $self = shift;
579 0         0 my $val = shift;
580 0         0 my $args = shift;
581 0 0       0 my $index = defined($args) ? join "|",0 ... $#$args : "\\d+";
582              
583 0         0 my $regexp_s = <<'EOP';
584             ^(.*?) # Start containing no args
585              
586             \$( # Variable starts with '$'
587             ($index) | # $0 without default value
588             \{\s*($index)\s* # ${0:12300} with default value
589             (?: :([^\}]+) )*\} # ?: --> clustering group, optional (${0} is also ok)
590             )
591              
592             (.*|$) # The rest which will get parsed next
593             EOP
594 0         0 $regexp_s =~ s/\$index/$index/g;
595 0         0 my $regexp = qr/$regexp_s/sx;
596 0 0       0 die "Cannot create placeholder regexp" if $@;
597 0         0 my $rest = $val;
598 0         0 my $ret = "";
599 0   0     0 while (defined($rest) && length($rest) && $rest =~ $regexp) {
      0        
600             # $1: start with no placeholder
601             # $2: literal variable as it is defined
602             # $3: variable name (0,1,2,3,...)
603             # $4: same as $3, but either $3 or $4 is defined
604             # $5: default value (if any)
605             # $6: rest which is processed next in the loop
606 0 0       0 my $start = defined($1) ? $1 : "";
607 0         0 my $orig_val = '$' . $2;
608 0 0       0 my $i = defined($3) ? $3 : $4;
609 0         0 my $default = $5;
610 0 0       0 my $end = defined($6) ? $6 : "";
611 0 0       0 $default =~ s/^\s*(.*)+?\s*$/$1/ if $default; # Trim whitespace
612             #print Dumper({start => $start, orig => $orig_val,end => $end, default=> $default, rest => $rest, i => $i});
613 0 0       0 if (defined($args)) {
614 0         0 my $repl = $args->[$i];
615 0 0       0 if (defined($repl)) {
616 0 0       0 if ($repl =~ /^\$(\d+)$/) {
617 0         0 my $new_index = $1;
618             #print "============== $val $new_index\n";
619             # Val is a placeholder itself
620 0 0       0 if (defined($default)) {
621 0         0 $ret .= $start . '${' . $new_index . ':' . $default . '}';
622             } else {
623 0         0 $ret .= $start . '$' . $new_index;
624             }
625             } else {
626 0         0 $ret .= $start . $repl;
627             }
628             } else {
629 0         0 $ret .= $start . $orig_val;
630             }
631             } else {
632             # We have to replace any left over placeholder either with its
633             # default value or with an empty value
634 0 0 0     0 if (defined($default)) {
    0          
635 0         0 $ret .= $start . $default;
636             } elsif (length($start) || length($end)) {
637 0         0 $ret .= $start;
638             } else {
639 0 0       0 if (!length($ret)) {
640             # No default value, nothing else for this value. We
641             # consider it undefined
642 0         0 return undef;
643             }
644             }
645             }
646 0         0 $rest = $end;
647             #print "... $ret$rest\n";
648             }
649 0 0       0 return $ret . (defined($rest) ? $rest : "");
650             }
651              
652             # Split up a 'Use' parent config reference, including possibly arguments
653             sub _parse_check_ref {
654 0     0   0 my $self = shift;
655 0         0 my $check_ref = shift;
656 0 0       0 if ($check_ref =~/^\s*(.+?)\((.*)\)\s*$/) {
657 0         0 my $name = $1;
658 0         0 my $args_s = $2;
659 0         0 my $args = [ parse_line('\s*,\s*',0,$args_s) ];
660 0         0 return ($name,$args);
661             } else {
662 0         0 return $check_ref;
663             }
664             }
665              
666             # Get the configuration as a hash
667             sub _get_config {
668 1     1   22 my $self = shift;
669 1         2 my $path = shift;
670 1         2 my $np = $self->{np};
671 1 50 33     23 $self->nagios_die("No configuration file " . $path . " found")
672             if ($path && ! -e $path);
673 1         16 return new JMX::Jmx4Perl::Config($path);
674             }
675              
676             # The global server config part
677             sub _server_config {
678 0     0   0 return shift->{server_config};
679             }
680              
681             # Create the nagios plugin used for preparing the nagios output
682             sub create_nagios_plugin {
683 1     1 0 2 my $self = shift;
684 1         10 my $np = Monitoring::Plugin->
685             new(
686             usage =>
687             "Usage: %s -u -m -a -c -w \n" .
688             " [--alias ] [--value ] [--base ] [--delta ]\n" .
689             " [--name ] [--label ] [--product ]\n".
690             " [--user ] [--password ] [--proxy ]\n" .
691             " [--target ] [--target-user ] [--target-password ]\n" .
692             " [--legacy-escape]\n" .
693             " [--config ] [--check ] [--server ] [-v] [--help]\n" .
694             " arg1 arg2 ....",
695             version => $JMX::Jmx4Perl::VERSION,
696             url => "http://www.jolokia.org",
697             plugin => "check_jmx4perl",
698             blurb => "This plugin checks for JMX attribute values on a remote Java application server",
699             extra => "\n\nYou need to deploy jolokia.war on the target application server or an intermediate proxy.\n" .
700             "Please refer to the documentation for JMX::Jmx4Perl for further details.\n\n" .
701             "For a complete documentation please consult the man page of check_jmx4perl or use the option --doc"
702             );
703 1         20234 $np->shortname(undef);
704 1         14 $self->add_common_np_args($np);
705 1         71 $self->add_nagios_np_args($np);
706 1         82 $np->{msg_handler} = new JMX::Jmx4Perl::Nagios::MessageHandler();
707 1         6 $np->getopts();
708 1         9787 return $np;
709             }
710              
711             sub add_common_np_args {
712 1     1 0 2 my $self = shift;
713 1         3 my $np = shift;
714              
715 1         7 $np->add_arg(
716             spec => "url|u=s",
717             help => "URL to agent web application (e.g. http://server:8080/jolokia/)",
718             );
719 1         86 $np->add_arg(
720             spec => "product=s",
721             help => "Name of app server product. (e.g. \"jboss\")",
722             );
723 1         120 $np->add_arg(
724             spec => "alias=s",
725             help => "Alias name for attribte (e.g. \"MEMORY_HEAP_USED\")",
726             );
727 1         88 $np->add_arg(
728             spec => "mbean|m=s",
729             help => "MBean name (e.g. \"java.lang:type=Memory\")",
730             );
731 1         72 $np->add_arg(
732             spec => "attribute|a=s",
733             help => "Attribute name (e.g. \"HeapMemoryUsage\")",
734             );
735 1         71 $np->add_arg(
736             spec => "operation|o=s",
737             help => "Operation to execute",
738             );
739 1         70 $np->add_arg(
740             spec => "value=s",
741             help => "Shortcut for specifying mbean/attribute/path. Slashes within names must be escaped with \\",
742             );
743 1         70 $np->add_arg(
744             spec => "delta|d:s",
745             help => "Switches on incremental mode. Optional argument are seconds used for normalizing.",
746             );
747 1         70 $np->add_arg(
748             spec => "path|p=s",
749             help => "Inner path for extracting a single value from a complex attribute or return value (e.g. \"used\")",
750             );
751 1         71 $np->add_arg(
752             spec => "target=s",
753             help => "JSR-160 Service URL specifing the target server"
754             );
755 1         75 $np->add_arg(
756             spec => "target-user=s",
757             help => "Username to use for JSR-160 connection (if --target is set)"
758             );
759 1         70 $np->add_arg(
760             spec => "target-password=s",
761             help => "Password to use for JSR-160 connection (if --target is set)"
762             );
763 1         87 $np->add_arg(
764             spec => "proxy=s",
765             help => "Proxy to use"
766             );
767 1         74 $np->add_arg(
768             spec => "user=s",
769             help => "User for HTTP authentication"
770             );
771 1         70 $np->add_arg(
772             spec => "password=s",
773             help => "Password for HTTP authentication"
774             );
775 1         69 $np->add_arg(
776             spec => "name|n=s",
777             help => "Name to use for output. Optional, by default a standard value based on the MBean ".
778             "and attribute will be used"
779             );
780 1         70 $np->add_arg(
781             spec => "legacy-escape!",
782             help => "Use legacy escape mechanism for Jolokia agents < 1.0"
783             );
784 1         70 $np->add_arg(
785             spec => "config=s",
786             help => "Path to configuration file. Default: ~/.j4p"
787             );
788 1         69 $np->add_arg(
789             spec => "server=s",
790             help => "Symbolic name of server url to use, which needs to be configured in the configuration file"
791             );
792 1         69 $np->add_arg(
793             spec => "check=s",
794             help => "Name of a check configuration as defined in the configuration file"
795             );
796 1         69 $np->add_arg(
797             spec => "method=s",
798             help => "HTTP method to use. Either \"get\" or \"post\""
799             );
800 1         68 $np->add_arg(
801             spec => "doc:s",
802             help => "Print the documentation of check_jmx4perl, optionally specifying the section (tutorial, args, config)"
803             );
804             }
805              
806             sub add_nagios_np_args {
807 1     1 0 2 my $self = shift;
808 1         2 my $np = shift;
809              
810 1         4 $np->add_arg(
811             spec => "base|base-alias|b=s",
812             help => "Base name, which when given, interprets critical and warning values as relative in the range 0 .. 100%. Must be given in the form mbean/attribute/path",
813             );
814 1         93 $np->add_arg(
815             spec => "base-mbean=s",
816             help => "Base MBean name, interprets critical and warning values as relative in the range 0 .. 100%. Requires a base-attribute, too",
817             );
818 1         76 $np->add_arg(
819             spec => "base-attribute=s",
820             help => "Base attribute for a relative check. Used together with base-mbean",
821             );
822 1         69 $np->add_arg(
823             spec => "base-path=s",
824             help => "Base path for relatie checks, where this path is used on the base attribute's value",
825             );
826 1         68 $np->add_arg(
827             spec => "unit=s",
828             help => "Unit of measurement of the data retreived. Recognized values are [B|KB|MN|GB|TB] for memory values and [us|ms|s|m|h|d] for time values"
829             );
830 1         68 $np->add_arg(
831             spec => "null=s",
832             help => "Value which should be used in case of a null return value of an operation or attribute. Is \"null\" by default"
833             );
834 1         70 $np->add_arg(
835             spec => "string",
836             help => "Force string comparison for critical and warning checks"
837             );
838 1         68 $np->add_arg(
839             spec => "numeric",
840             help => "Force numeric comparison for critical and warning checks"
841             );
842 1         68 $np->add_arg(
843             spec => "critical|c=s",
844             help => "Critical Threshold for value. " .
845             "See http://nagiosplug.sourceforge.net/developer-guidelines.html#THRESHOLDFORMAT " .
846             "for the threshold format.",
847             );
848 1         68 $np->add_arg(
849             spec => "warning|w=s",
850             help => "Warning Threshold for value.",
851             );
852 1         70 $np->add_arg(
853             spec => "label|l=s",
854             help => "Label to be used for printing out the result of the check. Placeholders can be used."
855             );
856 1         84 $np->add_arg(
857             spec => "perfdata=s",
858             help => "Whether performance data should be omitted, which are included by default."
859             );
860 1         76 $np->add_arg(
861             spec => "unknown-is-critical",
862             help => "Map UNKNOWN errors to errors with a CRITICAL status"
863             );
864             }
865              
866             # Access to configuration informations
867             # Known config options (key: cmd line arguments, values: keys in config);
868             my $SERVER_CONFIG_KEYS = {
869             "url" => "url",
870             "user" => "user",
871             "password" => "password",
872             "product" => "product",
873             "legacy_escape" => "legacyconfig"
874             };
875              
876             # Get target configuration or undef if no jmx-proxy mode
877             # is used
878             sub target_config {
879 0     0 0 0 return shift->_target_or_proxy_config("target","target-user","target-password");
880             }
881              
882             # Get proxy configuration or undef if no proxy configuration
883             # is used
884             sub proxy_config {
885 0     0 0 0 return shift->_target_or_proxy_config("proxy","proxy-user","proxy-password");
886             }
887              
888             sub _target_or_proxy_config {
889 0     0   0 my $self = shift;
890            
891 0         0 my $main_key = shift;
892 0         0 my $user_opt = shift;
893 0         0 my $password_opt = shift;
894              
895 0         0 my $np = $self->{np};
896 0         0 my $opts = $np->opts;
897 0         0 my $server_config = $self->_server_config;
898 0 0 0     0 if ($opts->{$main_key}) {
    0          
899             # Use configuration from the command line:
900             return {
901             url => $opts->{$main_key},
902             user => $opts->{$user_opt},
903 0         0 password => $opts->{$password_opt}
904             }
905             } elsif ($server_config && $server_config->{$main_key}) {
906             # Use configuration directly from the server definition:
907 0         0 return $server_config->{$main_key}
908             } else {
909 0         0 return undef;
910             }
911             }
912              
913             # Autoloading is used to fetch the proper connection parameters
914             sub AUTOLOAD {
915 1     1   3 my $self = shift;
916 1         2 my $np = $self->{np};
917 1         2 my $name = $AUTOLOAD;
918 1         8 $name =~ s/.*://; # strip fully-qualified portion
919 1         3 my $opts_name = $name;
920 1         3 $opts_name =~ s/_/-/;
921              
922 1 50       21 if ($SERVER_CONFIG_KEYS->{$name}) {
923 1 50       26 return $np->opts->{$opts_name} if $np->opts->{$opts_name};
924 0           my $c = $SERVER_CONFIG_KEYS->{$name};
925 0 0         if ($c) {
926 0           my @parts = split "/",$c;
927 0   0       my $h = $self->_server_config ||
928             return undef;
929 0           while (@parts) {
930 0           my $p = shift @parts;
931 0 0         return undef unless $h->{$p};
932 0           $h = $h->{$p};
933 0 0         return $h unless @parts;
934             }
935             } else {
936 0           return undef;
937             }
938             } else {
939 0           $self->nagios_die("No config attribute \"" . $name . "\" known");
940             }
941             }
942              
943             sub nagios_die {
944 0     0 0   my $self = shift;
945 0           my @args = @_;
946              
947 0           my $np = $self->{np};
948 0 0         $np->nagios_die(join("",@args),$np->opts->{'unknown-is-critical'} ? CRITICAL : UNKNOWN)
949             }
950              
951             # Declared here to avoid AUTOLOAD confusions
952       0     sub DESTROY {
953              
954             }
955              
956             =head1 LICENSE
957              
958             This file is part of jmx4perl.
959              
960             Jmx4perl is free software: you can redistribute it and/or modify
961             it under the terms of the GNU General Public License as published by
962             the Free Software Foundation, either version 2 of the License, or
963             (at your option) any later version.
964              
965             jmx4perl is distributed in the hope that it will be useful,
966             but WITHOUT ANY WARRANTY; without even the implied warranty of
967             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
968             GNU General Public License for more details.
969              
970             You should have received a copy of the GNU General Public License
971             along with jmx4perl. If not, see .
972              
973             =head1 AUTHOR
974              
975             roland@cpan.org
976              
977             =cut
978              
979             1;