dta-cab-http-check.perl

#!/usr/bin/perl -w

## File: dta-cab-http-check.perl
## Author: Bryan Jurish <jurish@bbaw.de>
## Description:
##  + DTA::CAB::Server::HTTP monitoring plugin (for nagios, icinga, etc)

use File::Basename qw(basename dirname);
use Monitoring::Plugin;
use LWP::UserAgent;
use URI;
use URI::Escape qw(uri_escape_utf8);
use JSON;
use Time::HiRes qw(gettimeofday tv_interval);
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use strict;

##======================================================================
## Version
our $VERSION = 0.05;
our $SVNID   = q(
  $HeadURL$
  $Id$
);

##======================================================================
## Globals

our ($help,$version);
our $mp = 'Monitoring::Plugin';   ##-- later: object
our $prog = basename($0);
our $qmode = 'status'; ##-- 'status' or 'query'
our $query = '';
our $expect = ''; ##-- regex for expected response in 'query' mode

our $timeout   = 30;
our $time_warn =  5;
our $time_crit = 10;

our $vl_silent = 0;
our $vl_debug  = 1;
our $vl_trace  = 2;
our $verbose  = $vl_silent;  ##-- 0..2

##======================================================================
## Command-Line
GetOptions(##-- general
	   'help|h' => \$help,
	   'version|V' => \$version,

	   ##-- behavior
	   'query-timeout|qt|timeout|t=i' => \$timeout,
	   'time-warn|tw|warn|w=i' => \$time_warn,
	   'time-critical|tc|critical|c=i' => \$time_crit,

	   ##-- query mode
	   'status|s' => sub { $qmode='status'; },
	   'query|q=s' => sub { $qmode='query'; $query=$_[1]; },
	   'expect|e=s' => \$expect,

	   ##-- logging
	   'verbose|v' => sub { ++$verbose; },
	  );

if ($version) {
  print STDERR "${prog} version ${VERSION}${SVNID}";
  exit 0;
}
pod2usage({-exitval=>0, -verbose=>0}) if ($help);


##-- Monitoring::Plugin interface object
$mp = Monitoring::Plugin->new
  (
   shortname => 'CAB',
   usage => 'Usage: %s [OPTIONS] CAB_SERVER_URL(s)...',
   version => $VERSION,
   #blurb   => $blurb,
   #extra   => $extra,
   #url     => $url,
   license => "perl5",
   plugin  => 'CAB',
   timeout => $timeout,
  );

##-- signal handling
$SIG{__DIE__} = sub {
  $mp->plugin_die(UNKNOWN, join('', @_));
};

##======================================================================
## verbose messaging

## undef = vmsg($level,@msg)
sub vmsg {
  my $level = shift;
  return if (!defined($level) || ($verbose < $level));
  print STDERR "$prog: ", @_, "\n";
}


##======================================================================
## MAIN

$mp->plugin_die("no server URL specified") if (!@ARGV);
my $url    = shift(@ARGV);
my $geturl = $url;
if ($qmode eq 'status' && $url !~ /\bstatus\b/) {
  $geturl .= ($url =~ m{/$} ? '' : '/') . "status?f=json";
}
elsif ($qmode eq 'query') {
  $geturl .= ($url =~ m{/$} ? '' : '/') . "query" if ($url !~ /\bquery\b/);
  $geturl .= ($url =~ /\?/ ? '&' : '?');
  my $qstr = $query;
  utf8::decode($qstr) if (!utf8::is_utf8($qstr));
  $geturl .= "qd=".uri_escape_utf8("$qstr\n");
}

##-- check for http-over-unix
if ($geturl =~ m{^(.+?)\+unix:(?://)?(.+?)[/\|]/(.*)$}i) {
  ##-- http+unix syntax
  my ($scheme,$sockpath,$uripath) = ($1,$2,$3);
  $geturl = "${scheme}:${sockpath}//${uripath}";
}
elsif ($geturl =~ m{^unix:(?://)?(.+?)(?:\||\%7C)(.*)$}i) {
  ##-- apache mod_proxy syntax
  my ($sockpath,$uristr) = ($1,$2);
  my $uri = URI->new($uristr)->as_string;
  $uri =~ s{//+}{${sockpath}//};
  $geturl = "$uri";
}
my $geturi = URI->new($geturl);

##-- sanitize thresholds
$time_crit = $timeout    if ($time_crit>0 && $timeout   < $time_crit);
$time_warn = $time_crit  if ($time_crit>0 && $time_crit < $time_warn);

##-- debug output
vmsg($vl_debug, "set url = $url");
vmsg($vl_debug, "set geturl = $geturl");
vmsg($vl_debug, "set timeout = ", $timeout);
vmsg($vl_debug, "set time_warn = ", $time_warn);
vmsg($vl_debug, "set time_crit = ", $time_crit);


##-- setup user agent
my $ua = LWP::UserAgent->new(
			     ssl_opts => {SSL_verify_mode=>'SSL_VERIFY_NONE'}, ##-- avoid "certificate verify failed" errors
			    )
  or die("$prog: failed to create user agent for URL $url: $!");

$ua->timeout($timeout);
my $t0  = [gettimeofday];
my ($rsp);
if ($geturi->path =~ m{[^/]//}) {
  ##-- http-over-unix; adapated from CAB::Client::HTTP::urequest_unix()

  ##-- setup LWP::Protocol::http::SocketUnixAlt handlers
  require LWP::Protocol::http::SocketUnixAlt;
  my $http_impl = LWP::Protocol::implementor("http");
  LWP::Protocol::implementor('http' => 'LWP::Protocol::http::SocketUnixAlt');

  ##-- suppress irritating warnings from LWP::Protocol::http via LWP::Protocol::http::SocketUnixAlt
  my $sigwarn  = $SIG{__WARN__};
  local $SIG{__WARN__} = sub {
    return if ($_[0] =~ m{Use of uninitialized value \$hhost.*LWP/Protocol/http\.pm});
    $sigwarn ? $sigwarn->(@_) : warn(@_);
  };

  ##-- UNIX-sockets don't like 'timeout' parameter: use alarm()
  $SIG{ALRM} = sub {
    die("timeout exceeded");
  };
  alarm($timeout);

  ##-- guts
  eval {
    $rsp = $ua->get($geturl)
      or die("failed to retrieve http-over-UNIX URL $geturl");
  };

  ##-- check for timeouts
  my $err = $@ // '';
  alarm(0);
  if (!$rsp && $err =~ /\btimeout exceeded\b/) {
    $rsp = HTTP::Response->new(500, "UNIX socket timeout");
  }

  ##-- reset handlers
  LWP::Protocol::implementor('http' => $http_impl);
} else {
  $rsp = $ua->get($geturl)
    or die("failed to retrieve URL $geturl");
}

my $time  = sprintf("%.3f", tv_interval($t0));

##-- parse response & add perforamance data
$mp->add_perfdata(label=>'time', value=>$time, uom=>'s');
my $status = {};
my $rc  = OK;
my $msg = '';
if ($rsp->is_success) {
  my $data = $rsp->decoded_content;
  vmsg($vl_trace, "got response = ", $data);

  if ($qmode eq 'status') {
    ##-- status check
    eval { $status = from_json($data); };
    die("$prog: failed to parse status response: $@") if (!$status);

    ##-- get status perfdata
    my $memMB = sprintf("%.2f", ($status->{memSize}//0) / 1024);
    my $rssMB = sprintf("%.2f", ($status->{memRSS}//0) / 1024);
    $mp->add_perfdata(label=>'mem', value=>$memMB, uom=>'MB');
    $mp->add_perfdata(label=>'nreq', value=>($status->{nRequests}//0), uom=>'c');
    $mp->add_perfdata(label=>'nerr', value=>($status->{nErrors}//0), uom=>'c');
    {
      no warnings 'numeric';
      $mp->add_perfdata(label=>'ncached', value=>($status->{nCacheHits}+0), uom=>'c');
    };

    ##-- new perfdata for DTA::CAB v1.101 (2018-03-22 14:10:24+0100)
    $mp->add_perfdata(label=>'rss', value=>$rssMB, uom=>'MB');
    foreach (1,5,15) {
      $mp->add_perfdata(label=>"qtavg$_", value=>sprintf("%.4f",1000*($status->{"qtAvg$_"}//0)), uom=>'ms');
    }

    ##-- get return message
    my $st_ver = $status->{version}//'?';
    $st_ver   =~ s/\|.*$//;
    $msg = "$url - ${time}s ${memMB}MB $st_ver";
  }
  elsif ($qmode eq 'query') {
    ##-- query check
    $msg = "$url - ${time}s";
    if ($expect) {
      if ($data !~ /$expect/o) {
	$rc = CRITICAL;
	$msg = "$url - ERROR - pattern not found";
      }
    }
  }
  else {
    ##-- unknown query mode
    $msg = "$url - ${time}s";
  }
}
elsif ($time_crit<=0 && $rsp->message =~ /\b(?:timeout|resource temporarily unavailable)\b/i) {
  ##-- treat timeouts as warnings
  $rc = WARNING;
  $msg = "$url - TIMEOUT - ".$rsp->status_line." - ${time}s";
}
else {
  ##-- anything else is CRITICAL
  $rc = CRITICAL;
  $msg = "$url - ERROR - ".$rsp->status_line." - ${time}s";
}

##-- check threshholds
my $thresh_crit = $time_crit > 0 ? $time_crit : undef;
my $time_rc     = $mp->check_threshold(check=>$time, warning=>$time_warn, critical=>$thresh_crit);
$rc             = $time_rc if ($time_rc > $rc);

##-- final exit
$mp->plugin_exit($rc, "$msg");

__END__

=pod

=head1 NAME

dta-cab-http-check.perl - DTA::CAB http-server monitoring plugin for nagios/icinga

=head1 SYNOPSIS

 dta-cab-http-check.perl [OPTIONS] SERVER_URL

 Options:
  -h, -help               # this help message
  -V, -version            # show version information and exit
  -t, -timeout SECS       # set probe query timeout (default=60)
  -w, -time-warn SECS     # set response time threshold for 'warning' state (default=10)
  -c, -time-crit SECS     # set response time threshold for 'critical' state (default=60)
                          #     (-c=0: treat timeouts as WARNING states)
  -s, -status             # perform a 'status' query SERVER_URL/status?f=json (default)
  -q, -query QSTR         # perform a default query on SERVER_URL/query?qd=QSTR
  -v, -verbose            # increase verbosity level

 Arguments:
  SERVER_URL              # url to check

 Examples:
   dta-cab-http-check.perl http://kaskade.dwds.de:9099
   dta-cab-http-check.perl http+unix:/tmp/cab/dstar-http-9096.sock//


=cut

##------------------------------------------------------------------------------
## Description
##------------------------------------------------------------------------------
=pod

=head1 DESCRIPTION

...

=cut

##------------------------------------------------------------------------------
## See Also
##------------------------------------------------------------------------------
=pod

=head1 SEE ALSO

...

=cut

##------------------------------------------------------------------------------
## Footer
##------------------------------------------------------------------------------
=pod

=head1 COPYRIGHT

Copyright (c) 2016-2019, Bryan Jurish.  All rights reserved.

This package is free software.  You may redistribute it
and/or modify it under the same terms as Perl itself,
either Perl 5.20.2 or at your option any newer version
of Perl 5 you have available.

=cut

##------------------------------------------------------------------------------
## Footer
##------------------------------------------------------------------------------
=pod

=head1 AUTHOR

Bryan Jurish E<lt>jurish@bbaw.de<gt>

=cut