view release on metacpan or  search on metacpan

dta-cab-http-check.perl  view on Meta::CPAN

##-- 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);