#!/usr/local/bin/perl # # File: lwp-http.mon # Author: Daniel Hagerty, hag@linnaean.org # Date: Sun Mar 19 22:06:02 2000 # Description: Perform a simple top level HTTP get using LWP. # Lots of options. # # $Id: lwp-http.mon,v 1.3 2000/03/20 05:55:48 hag Exp $ # # 2002-09-02 Dobrica Pavlinusic # added option -o which will return success if ANY of server responded with # success (so that you can ignore alerts if backup servers are working) use strict; use LWP::UserAgent; use HTTP::Cookies; use HTTP::Request; use Getopt::Long qw(:config pass_through); # leave ARGV use File::Basename; use URI; ### # Configure this. my $maintainer = 'youremailhere@localhost'; ## my $port; my $directory; my $regex; my $proto = "http"; my $timeout = 60; my $invert; my $nozero; my $one; my $envproxy; my $proxy; my $cookies; my $extended_help; my $version = "0.1"; my $agent = "Yet Another Monitor Bot/$version"; my $u_proto; ### sub main { do_usage() if(! @_); $directory =~ s/^\///; # Nuke leading slash $u_proto = $proto; $u_proto =~ tr/[a-z]/[A-Z]/; my $user_agent = LWP::UserAgent->new() || lose("LWP create failure"); $user_agent->agent($agent); $user_agent->from($maintainer); $user_agent->timeout($timeout); $user_agent->proxy(['http', 'ftp'], $proxy) if ($proxy); $user_agent->env_proxy() if ($envproxy); my @failed; my @available; my %failure; host: foreach my $host (@_) { my $ht_lose = sub { push(@failed, $host); $failure{$host} = join(" ", @_); # This generates a warning. next host; }; if($cookies) { # Generate new cookies for each host. my $cookies = HTTP::Cookies->new() || &{$ht_lose}("HTTP::Cookies create failure"); $user_agent->cookie_jar($cookies); } # XXX Kludge around some wierness with generating our own # URI interacting with cookies. my $uri_str = "$proto://$host/$directory"; my $request = HTTP::Request->new("GET" => $uri_str) || &{$ht_lose}("HTTP::Request create failure"); my $uri = $request->uri(); $uri->port($port) if(defined($port)); my $response = $user_agent->request($request) || &{$ht_lose}("UserAgent request failure"); unless($response->is_success) { &{$ht_lose}("Request failed:", $response->message); } my $strref = $response->content_ref; if(!$nozero && length($$strref) == 0) { &{$ht_lose}("Empty document"); } if(defined($regex)) { my $winning; map {$winning++ if(/$regex/);} split("\n", $$strref); if($invert) { &{$ht_lose}("Failure regex matches:", $winning) if($winning); } elsif(!$winning) { &{$ht_lose}("Regex not found"); } } push(@available, $host); } if(@failed) { print "$u_proto Failures: " . join(" ", @failed) . "\n"; foreach my $fail (@failed) { print "$fail: $failure{$fail}\n"; } if ($one && ($#available+1) > 0) { print "$u_proto Available: ".join(" ", @available)."\n"; } else { exit(1); } } exit; } sub lose { die join(" ", @_); } sub do_usage { my $base = basename $0; print STDERR "Usage: $base [options...] hosts ...\n"; if($extended_help) { print <<'EOF'; -h Help. You're reading it. -d|--url URL URL to test on the remote host. Default is /. -p|--port PORT Port to connect to. Default is proto specific. -P|--proto PROTO Protocol to fetch. Default is http. -s|--https Fetch via https. Equivalent to -P https. -t|--timeout TIMEOUT Timeout for the fetch. Default is 60 seconds. -r|--regex REGEX A regexp that the retrieved content must match. -v|--invert Invert the regular expression. Content must NOT match. -z|--nozero Supress zero-length check. -c|--cookies Enable Cookies. -o|--one Return success if at least One server is available. --envproxy User proxy server from env http_proxy and friends. --proxy PROXY Set proxy explicitly EOF } exit 1; } ### GetOptions( 'url|d=s' => \$directory, 'port|p=i' => \$port, 'timeout|t=i' => \$timeout, 'regex|r=s' => \$regex, 'https|s=s' => sub { $proto = "https" }, 'proto|P=s' => \$proto, 'invert|v' => \$invert, 'nozero|z' => \$nozero, 'cookies|c' => \$cookies, 'one|o' => \$one, 'envproxy' => \$envproxy, 'proxy=s' => \$proxy, 'help|h' => \$extended_help ) || do_usage(); &main(@ARGV); # EOF