| 88 |
rodolico |
1 |
#! /usr/bin/env perl
|
|
|
2 |
|
|
|
3 |
use strict;
|
|
|
4 |
use warnings;
|
|
|
5 |
|
| 89 |
rodolico |
6 |
# Currently three types of tests
|
|
|
7 |
# type: lwp
|
|
|
8 |
# url: site to test
|
|
|
9 |
# timeout: optional integer, number of seconds. defaults to 'default timeout'
|
|
|
10 |
#
|
|
|
11 |
# type: ping
|
|
|
12 |
# url: site to test
|
|
|
13 |
# timeout: optional integer, number of seconds. defaults to 'default timeout'
|
|
|
14 |
#
|
|
|
15 |
# type: netcat
|
|
|
16 |
# url: site to test
|
|
|
17 |
# port: port to test on
|
|
|
18 |
# timeout: optional integer, number of seconds. defaults to 'default timeout'
|
|
|
19 |
|
| 88 |
rodolico |
20 |
use Data::Dumper;
|
| 89 |
rodolico |
21 |
use FindBin;
|
|
|
22 |
use File::Spec;
|
| 88 |
rodolico |
23 |
|
| 89 |
rodolico |
24 |
# name of script directory, no trailing slash
|
|
|
25 |
my $MY_DIR = $FindBin::Bin;
|
|
|
26 |
# name of currently executing file
|
|
|
27 |
my $MY_NAME = $FindBin::Script;
|
| 88 |
rodolico |
28 |
|
| 89 |
rodolico |
29 |
my $configName = $MY_DIR . '/' . $MY_NAME . '.yaml';
|
|
|
30 |
|
|
|
31 |
# hashref which holds configuration
|
|
|
32 |
my $config;
|
|
|
33 |
|
|
|
34 |
# simply read the contents of YAML file $filename into
|
|
|
35 |
# hashref and return the hashref
|
| 88 |
rodolico |
36 |
sub loadConf {
|
| 89 |
rodolico |
37 |
use YAML::Tiny;
|
|
|
38 |
my $filename = shift;
|
|
|
39 |
my $conf = YAML::Tiny->read( $filename );
|
|
|
40 |
return $conf->[0];
|
| 88 |
rodolico |
41 |
}
|
|
|
42 |
|
| 89 |
rodolico |
43 |
# not used. May use it later, who knows.
|
|
|
44 |
sub saveConf {
|
|
|
45 |
use YAML::Tiny;
|
|
|
46 |
my ( $filename, $config ) = @_;
|
|
|
47 |
my $yaml = YAML::Tiny->new( $config );
|
|
|
48 |
$yaml->write( $filename );
|
|
|
49 |
}
|
| 88 |
rodolico |
50 |
|
| 89 |
rodolico |
51 |
# check using netcat
|
|
|
52 |
sub checkNetCat {
|
|
|
53 |
my ($url, $port, $timeout ) = @_;
|
|
|
54 |
my $netcat = `which nc`;
|
|
|
55 |
chomp $netcat;
|
|
|
56 |
unless ( $netcat ) {
|
|
|
57 |
warn "Netcat not found, not testing\n";
|
|
|
58 |
return 0;
|
|
|
59 |
}
|
|
|
60 |
$netcat = join( ' ', ($netcat, "-z -w $timeout", $url, $port ) );
|
|
|
61 |
`$netcat`;
|
|
|
62 |
return not $? >> 8;
|
| 88 |
rodolico |
63 |
}
|
|
|
64 |
|
| 89 |
rodolico |
65 |
# this has only been tested on http and https, but with a little work
|
|
|
66 |
# could do echo, ftp
|
|
|
67 |
# will NOT work with some WordPress sites since it goes into
|
|
|
68 |
# infinite redirect loop
|
| 88 |
rodolico |
69 |
sub checkHTTP {
|
| 89 |
rodolico |
70 |
use LWP::UserAgent; # probably should eval this in case not loaded
|
| 88 |
rodolico |
71 |
my ($url, $timeout) = @_;
|
| 89 |
rodolico |
72 |
# just getting HEAD, so small amount of data
|
| 88 |
rodolico |
73 |
my $r = HTTP::Request->new( 'HEAD', $url );
|
| 89 |
rodolico |
74 |
# new agent, make the request, return success
|
| 88 |
rodolico |
75 |
my $ua = LWP::UserAgent->new();
|
|
|
76 |
my $res = $ua->request($r);
|
|
|
77 |
return $res->is_success;
|
|
|
78 |
}
|
|
|
79 |
|
| 89 |
rodolico |
80 |
# we're only using icmp. Probably could extend to other things, but
|
|
|
81 |
# netcat and lwp do them also, I think.
|
|
|
82 |
# basically a ping. Must be run as root.
|
| 88 |
rodolico |
83 |
sub checkPing {
|
|
|
84 |
my ($url,$type,$timeout) = @_;
|
|
|
85 |
use Net::Ping;
|
| 89 |
rodolico |
86 |
# verify running as root
|
|
|
87 |
my $login = (getpwuid $>);
|
|
|
88 |
if ( $login ne 'root' ) {
|
|
|
89 |
warn "This script must be run as root for ping type\n";
|
|
|
90 |
return 0;
|
|
|
91 |
}
|
|
|
92 |
|
| 88 |
rodolico |
93 |
my $p = Net::Ping->new('icmp');
|
|
|
94 |
return $p->ping( $url ) ? 1 : 0;
|
|
|
95 |
}
|
|
|
96 |
|
| 89 |
rodolico |
97 |
# determines which test to run, runs it and returns results
|
| 88 |
rodolico |
98 |
sub runTest {
|
|
|
99 |
my $parameters = shift;
|
| 89 |
rodolico |
100 |
#die Dumper( $parameters );
|
| 88 |
rodolico |
101 |
my $result;
|
|
|
102 |
if ( $parameters->{'type'} eq 'lwp' ) {
|
| 89 |
rodolico |
103 |
$result = &checkHTTP( $parameters->{'url'}, $parameters->{'timeout'} );
|
| 88 |
rodolico |
104 |
} elsif ( $parameters->{'type'} eq 'ping' ) {
|
| 89 |
rodolico |
105 |
$result = checkPing( $parameters->{'url'}, $parameters->{'timeout'} );
|
|
|
106 |
} elsif ( $parameters->{'type'} eq 'netcat' ) {
|
|
|
107 |
$result = checkNetCat( $parameters->{'url'}, $parameters->{'port'}, $parameters->{'timeout'} );
|
|
|
108 |
} else {
|
|
|
109 |
$result = 0;
|
| 88 |
rodolico |
110 |
}
|
|
|
111 |
return $result;
|
|
|
112 |
}
|
|
|
113 |
|
| 89 |
rodolico |
114 |
# just make up the flag file name in one place so we don't
|
|
|
115 |
# forget to do it everyplace it is needed
|
|
|
116 |
sub flagFileName {
|
|
|
117 |
my $name = shift;
|
|
|
118 |
return "/tmp/$name.down";
|
|
|
119 |
}
|
| 88 |
rodolico |
120 |
|
| 90 |
rodolico |
121 |
# report the outage
|
|
|
122 |
sub reportOutage {
|
|
|
123 |
my ( $name,$parameters ) = @_;
|
|
|
124 |
# do something really nice here
|
|
|
125 |
}
|
|
|
126 |
|
| 89 |
rodolico |
127 |
# this will put a flag file in /tmp/monitorNetwork which will control
|
|
|
128 |
# countdown in case of failure
|
|
|
129 |
# if the countdown is exceeded, it will report the status
|
|
|
130 |
sub processFailure {
|
|
|
131 |
my ( $name, $parameters ) = @_;
|
| 90 |
rodolico |
132 |
# temporary for testing
|
| 89 |
rodolico |
133 |
print "Failed test for $name\n";
|
| 90 |
rodolico |
134 |
my $flagFileName = $flagFileName( $name );
|
|
|
135 |
my $remainingCounts = $parameters->{'failure count'};
|
|
|
136 |
if ( -f $flagFileName ) {
|
|
|
137 |
# open flag file, read the value into $remaingCounts
|
|
|
138 |
return if $remainingCounts == -1;
|
|
|
139 |
}
|
|
|
140 |
if ( $remainingCounts-- == 0 ) {
|
|
|
141 |
&ReportOutage( $name, $parameters );
|
|
|
142 |
}
|
|
|
143 |
# open flag file, write new $remainingCounts to it
|
| 88 |
rodolico |
144 |
}
|
| 89 |
rodolico |
145 |
|
|
|
146 |
# we are up, so check for any flag file and unlink if found
|
|
|
147 |
sub cleanUp {
|
|
|
148 |
my $name = shift;
|
|
|
149 |
$name = &flagFileName( $name );
|
|
|
150 |
unlink $name if -f $name;
|
|
|
151 |
}
|
|
|
152 |
|
|
|
153 |
#######################################################################
|
|
|
154 |
# Main Code
|
|
|
155 |
#######################################################################
|
|
|
156 |
|
|
|
157 |
# get the config file
|
|
|
158 |
$config = &loadConf( $configName );
|
|
|
159 |
|
|
|
160 |
# loop through each site to check
|
|
|
161 |
foreach my $testToRun( keys %{$config->{'sites to check'}} ) {
|
|
|
162 |
# there is a faster way of doing this, but I don't remember it
|
|
|
163 |
# you can merge two hashes, overwriting one with values if not existing in the other
|
|
|
164 |
# I'll look it up, but for now
|
|
|
165 |
foreach my $key ( keys %{$config->{'defaults'}} ) {
|
|
|
166 |
$config->{'sites to check'}->{$testToRun}->{$key} = $config->{'defaults'}->{$key} unless defined $config->{'sites to check'}->{$testToRun}->{$key};
|
|
|
167 |
}
|
|
|
168 |
# run the test
|
|
|
169 |
if ( &runTest( $config->{'sites to check'}->{$testToRun} ) ) {
|
|
|
170 |
&cleanUp( $testToRun ); # success, clean up any old stuff
|
|
|
171 |
} else { # failure, this is what we're here for
|
|
|
172 |
&processFailure( $testToRun, $config->{'sites to check'}->{$testToRun} );
|
|
|
173 |
}
|
|
|
174 |
}
|