212 lines
4.5 KiB
Perl
212 lines
4.5 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Use try to connect to a proxy server.
|
|
# For use with "mon".
|
|
#
|
|
# Modified by Silvan Calarco
|
|
# it just returns ok if the proxy server returns a 400 (page not found) error
|
|
# and defaults to port 3128
|
|
#
|
|
# proxy.monitor [-p port] [-t secs] [-u url] [-a agent] [-o] host [host...]
|
|
#
|
|
# -p port TCP port to connect to (defaults to 3128)
|
|
# -t secs timeout, defaults to 30
|
|
# -u url path to get, defaults to "/"
|
|
# -a agent User-Agent, default to "mon.d/proxy.monitor"
|
|
# -o omit http headers from healthy hosts
|
|
#
|
|
# Jon Meek
|
|
# American Cyanamid Company
|
|
# Princeton, NJ
|
|
#
|
|
# $Id: proxy.monitor 1.4 Sat, 30 Jun 2001 14:44:29 -0400 trockij $
|
|
#
|
|
# Copyright (C) 1998, Jim Trocki
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
#
|
|
use Getopt::Std;
|
|
use English;
|
|
use Data::Dumper;
|
|
|
|
sub httpGET;
|
|
|
|
getopts ("p:t:u:a:o");
|
|
$PORT = $opt_p || 3128;
|
|
$TIMEOUT = $opt_t || 30;
|
|
$URL = $opt_u || "/";
|
|
$USERAGENT = $opt_a || "mon.d/squid.monitor";
|
|
|
|
my %good;
|
|
my %bad;
|
|
|
|
exit 0 if (!@ARGV);
|
|
|
|
foreach my $host (@ARGV) {
|
|
my $result = httpGET ($host, $PORT);
|
|
|
|
if (!$result->{"ok"}) {
|
|
$bad{$host} = $result;
|
|
} else {
|
|
$good{$host} = $result;
|
|
}
|
|
}
|
|
|
|
my $ret;
|
|
|
|
if (keys %bad) {
|
|
$ret = 1;
|
|
print join (" ", sort keys %bad), "\n";
|
|
} else {
|
|
$ret = 0;
|
|
print "\n";
|
|
}
|
|
|
|
foreach my $h (keys %bad) {
|
|
print "HOST $h: $bad{$h}->{error}\n";
|
|
if ($bad{$h}->{"header"} ne "") {
|
|
print $bad{$h}->{"header"}, "\n";
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
if (!$opt_o)
|
|
{
|
|
foreach my $h (keys %good) {
|
|
print "HOST $h: ok\n";
|
|
print $good{$h}->{"header"}, "\n";
|
|
print "\n";
|
|
}
|
|
}
|
|
|
|
exit $ret;
|
|
|
|
|
|
sub httpGET {
|
|
use Socket;
|
|
use Sys::Hostname;
|
|
|
|
my($Server, $Port) = @_;
|
|
my($ServerOK, $TheContent);
|
|
|
|
$TheContent = '';
|
|
|
|
my $Path = $URL;
|
|
|
|
my $result;
|
|
|
|
###############################################################
|
|
eval {
|
|
local $SIG{ALRM} = sub { die "Timeout Alarm" };
|
|
alarm $TIMEOUT;
|
|
|
|
my $err = &OpenSocket($Server, $Port); # Open a connection to the server
|
|
|
|
if ($err ne "") { # Failure to open the socket
|
|
$result = {
|
|
"ok" => 0,
|
|
"error" => $err,
|
|
"header" => undef,
|
|
};
|
|
|
|
return undef;
|
|
}
|
|
|
|
print S "GET $Path HTTP/1.0\r\n";
|
|
print S "Host: $Server\r\n";
|
|
print S "User-Agent: $USERAGENT\r\n\r\n";
|
|
|
|
while ($in = <S>) {
|
|
$TheContent .= $in; # Store data for later processing
|
|
}
|
|
|
|
# HTTP/1.1 200 OK
|
|
|
|
if ($TheContent =~ /^HTTP\/([\d\.]+)\s+(200|30[12]|40[01])\b/) {
|
|
$ServerOK = 1;
|
|
} else {
|
|
$ServerOK = 0;
|
|
}
|
|
|
|
close(S);
|
|
alarm 0; # Cancel the alarm
|
|
|
|
};
|
|
|
|
my ($header) = ($TheContent =~ /^(.*?)\r?\n\r?\n/s);
|
|
|
|
if ($EVAL_ERROR and ($EVAL_ERROR =~ /^Timeout Alarm/)) {
|
|
return {
|
|
"ok" => 0,
|
|
"error" => "timeout after $TIMEOUT seconds",
|
|
"header" => $header,
|
|
};
|
|
}
|
|
|
|
if ($result->{"error"} ne "") {
|
|
return $result;
|
|
}
|
|
|
|
return {
|
|
"ok" => $ServerOK,
|
|
"header" => $header,
|
|
"error" => undef,
|
|
};
|
|
}
|
|
|
|
#
|
|
# Make a Berkeley socket connection between this program and a TCP port
|
|
# on another (or this) host. Port can be a number or a named service
|
|
#
|
|
# returns "" on success, or an error string on failure
|
|
#
|
|
sub OpenSocket {
|
|
my ($host, $port) = @_;
|
|
|
|
my $proto = (getprotobyname('tcp'))[2];
|
|
|
|
return ("could not get protocol") if (!defined $proto);
|
|
|
|
my $conn_port;
|
|
|
|
if ($port =~ /^\d+$/) {
|
|
$conn_port = $port;
|
|
|
|
} else {
|
|
$conn_port = (getservbyname($port, 'tcp'))[2];
|
|
return ("could not getservbyname for $port")
|
|
if (!defined $conn_port);
|
|
}
|
|
|
|
my $host_addr = (gethostbyname($host))[4];
|
|
|
|
return ("gethostbyname failure")
|
|
if (!defined $host_addr);
|
|
|
|
my $that = sockaddr_in ($conn_port, $host_addr);
|
|
|
|
if (!socket (S, &PF_INET, &SOCK_STREAM, $proto)) {
|
|
return ("socket: $!");
|
|
}
|
|
|
|
if (!connect (S, $that)) {
|
|
return ("connect: $!");
|
|
}
|
|
|
|
select(S); $| = 1; select(STDOUT);
|
|
|
|
"";
|
|
}
|