Rev 93 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
#! /usr/bin/env perl
use strict;
use warnings;
# Currently three types of tests
# type: lwp
# url: site to test
# timeout: optional integer, number of seconds. defaults to 'default timeout'
#
# type: ping
# url: site to test
# timeout: optional integer, number of seconds. defaults to 'default timeout'
#
# type: netcat
# url: site to test
# port: port to test on
# timeout: optional integer, number of seconds. defaults to 'default timeout'
# additional parameters: any additional cli parameters to add.
use Data::Dumper;
use FindBin;
use File::Spec;
# name of script directory, no trailing slash
my $MY_DIR = $FindBin::Bin;
# name of currently executing file
my $MY_NAME = $FindBin::Script;
my $configName = $MY_DIR . '/' . $MY_NAME . '.yaml';
# hashref which holds configuration
my $config;
# simply read the contents of YAML file $filename into
# hashref and return the hashref
sub loadConf {
use YAML::Tiny;
my $filename = shift;
my $conf = YAML::Tiny->read( $filename );
return $conf->[0];
}
# not used. May use it later, who knows.
sub saveConf {
use YAML::Tiny;
my ( $filename, $config ) = @_;
my $yaml = YAML::Tiny->new( $config );
$yaml->write( $filename );
}
# check using netcat
sub checkNetCat {
my ($url, $port, $timeout, $additionalParameters ) = @_;
my $netcat = `which nc`;
chomp $netcat;
unless ( $netcat ) {
warn "Netcat not found, not testing\n";
return 0;
}
$netcat = join( ' ', ($netcat, "-z -w $timeout", $additionalParameters, $url, $port ) );
print "\t$netcat\n" if $config->{'TESTING'};
`$netcat`;
return not $? >> 8;
}
# this has only been tested on http and https, but with a little work
# could do echo, ftp
# will NOT work with some WordPress sites since it goes into
# infinite redirect loop
sub checkHTTP {
use LWP::UserAgent; # probably should eval this in case not loaded
my ($url, $timeout) = @_;
# just getting HEAD, so small amount of data
my $r = HTTP::Request->new( 'HEAD', $url );
# new agent, make the request, return success
my $ua = LWP::UserAgent->new();
my $res = $ua->request($r);
return $res->is_success;
}
# we're only using icmp. Probably could extend to other things, but
# netcat and lwp do them also, I think.
# basically a ping. Must be run as root.
sub checkPing {
my ($url,$type,$timeout) = @_;
use Net::Ping;
# verify running as root
my $login = (getpwuid $>);
if ( $login ne 'root' ) {
warn "This script must be run as root for ping type\n";
return 0;
}
my $p = Net::Ping->new('icmp');
return $p->ping( $url ) ? 1 : 0;
}
# determines which test to run, runs it and returns results
sub runTest {
my $parameters = shift;
#die Dumper( $parameters );
my $result;
if ( $parameters->{'type'} eq 'lwp' ) {
$result = &checkHTTP( $parameters->{'url'}, $parameters->{'timeout'} );
} elsif ( $parameters->{'type'} eq 'ping' ) {
$result = checkPing( $parameters->{'url'}, $parameters->{'timeout'} );
} elsif ( $parameters->{'type'} eq 'netcat' ) {
$result = checkNetCat(
$parameters->{'url'},
$parameters->{'port'},
$parameters->{'timeout'},
defined $parameters->{'additional parameters'} ? $parameters->{'additional parameters'} : ''
);
} else {
warn "Unknown test type $parameters->{type}, aborting test\n";
$result = 0;
}
return $result;
}
# just make up the flag file name in one place so we don't
# forget to do it everyplace it is needed
sub flagFileName {
my $name = shift;
return "/tmp/$name.down";
}
# Report outage via system mail
# your system must be able to send e-mail from 'report from'
# otherwise, you'll need to use something like sendemail.pl
# apt install libemail-sender-perl libemail-mime-perl
sub reportViaMail {
my ( $name,$parameters ) = @_;
use Email::MIME;
my $message = Email::MIME->create(
header_str => [
From => $parameters->{'report from'},
To => $parameters->{'report to'},
Subject => "Outage on $name",
],
attributes => {
encoding => 'quoted-printable',
charset => 'ISO-8859-1',
},
body_str => "$name has been reported as current state down\n",
);
# send the message
use Email::Sender::Simple qw(sendmail);
sendmail($message);
}
# report the outage
sub reportOutage {
my ( $name,$parameters ) = @_;
if ( $parameters->{'report type'} eq 'mail' ) {
&reportViaMail( $name,$parameters );
} else {
warn "Do not have a way of notifying outage for $name\n";
}
}
# this will put a flag file in /tmp/monitorNetwork which will control
# countdown in case of failure
# if the countdown is exceeded, it will report the status
sub processFailure {
my ( $name, $parameters ) = @_;
# temporary for testing
my $flagFileName = &flagFileName( $name );
my $remainingCounts = $parameters->{'failure count'};
print "$name => Failed\n" if $config->{'TESTING'};
if ( -f $flagFileName ) {
# open flag file, read the value into $remaingCounts
return if $remainingCounts == -1;
}
if ( $remainingCounts-- == 0 ) {
&reportOutage( $name, $parameters );
}
# open flag file, write new $remainingCounts to it
}
# we are up, so check for any flag file and unlink if found
sub cleanUp {
my $name = shift;
print "$name => Success\n" if $config->{'TESTING'};
$name = &flagFileName( $name );
unlink $name if -f $name;
}
#######################################################################
# Main Code
#######################################################################
# get the config file
$config = &loadConf( $configName );
# loop through each site to check
foreach my $testToRun( keys %{$config->{'sites to check'}} ) {
# there is a faster way of doing this, but I don't remember it
# you can merge two hashes, overwriting one with values if not existing in the other
# I'll look it up, but for now
foreach my $key ( keys %{$config->{'defaults'}} ) {
$config->{'sites to check'}->{$testToRun}->{$key} = $config->{'defaults'}->{$key} unless defined $config->{'sites to check'}->{$testToRun}->{$key};
}
# run the test
if ( &runTest( $config->{'sites to check'}->{$testToRun} ) ) {
&cleanUp( $testToRun ); # success, clean up any old stuff
} else { # failure, this is what we're here for
&processFailure( $testToRun, $config->{'sites to check'}->{$testToRun} );
}
}