viewvc.cgi/mon-modules/lwp-http.mon

#!/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 <dpavlin@rot13.org>
# 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
1	dpavlin	1.1	#!/usr/local/bin/perl
2	dpavlin	1.4	#
3	dpavlin	1.1	# File: lwp-http.mon
4			# Author: Daniel Hagerty, hag@linnaean.org
5			# Date: Sun Mar 19 22:06:02 2000
6			# Description: Perform a simple top level HTTP get using LWP.
7			# Lots of options.
8			#
9			# $Id: lwp-http.mon,v 1.3 2000/03/20 05:55:48 hag Exp $
10	dpavlin	1.2	#
11			# 2002-09-02 Dobrica Pavlinusic <dpavlin@rot13.org>
12			# added option -o which will return success if ANY of server responded with
13			# success (so that you can ignore alerts if backup servers are working)
14	dpavlin	1.1
15			use strict;
16
17			use LWP::UserAgent;
18			use HTTP::Cookies;
19			use HTTP::Request;
20	dpavlin	1.4	use Getopt::Long qw(:config pass_through); # leave ARGV
21	dpavlin	1.1	use File::Basename;
22			use URI;
23
24			###
25
26			# Configure this.
27			my $maintainer = 'youremailhere@localhost';
28
29			##
30
31			my $port;
32			my $directory;
33			my $regex;
34			my $proto = "http";
35			my $timeout = 60;
36	dpavlin	1.4	my $invert;
37			my $nozero;
38			my $one;
39			my $envproxy;
40			my $proxy;
41			my $cookies;
42			my $extended_help;
43	dpavlin	1.1
44			my $version = "0.1";
45			my $agent = "Yet Another Monitor Bot/$version";
46
47			my $u_proto;
48
49			###
50
51			sub main {
52	dpavlin	1.4	do_usage() if(! @_);
53	dpavlin	1.1
54			$directory =~ s/^\///; # Nuke leading slash
55			$u_proto = $proto; $u_proto =~ tr/[a-z]/[A-Z]/;
56
57			my $user_agent = LWP::UserAgent->new() \|\| lose("LWP create failure");
58			$user_agent->agent($agent);
59			$user_agent->from($maintainer);
60			$user_agent->timeout($timeout);
61	dpavlin	1.4	$user_agent->proxy(['http', 'ftp'], $proxy) if ($proxy);
62			$user_agent->env_proxy() if ($envproxy);
63	dpavlin	1.1
64			my @failed;
65	dpavlin	1.2	my @available;
66	dpavlin	1.1	my %failure;
67			host:
68			foreach my $host (@_) {
69			my $ht_lose = sub {
70			push(@failed, $host);
71			$failure{$host} = join(" ", @_);
72
73			# This generates a warning.
74			next host;
75			};
76
77	dpavlin	1.4	if($cookies) {
78	dpavlin	1.1	# Generate new cookies for each host.
79			my $cookies = HTTP::Cookies->new() \|\|
80			&{$ht_lose}("HTTP::Cookies create failure");
81
82			$user_agent->cookie_jar($cookies);
83			}
84
85			# XXX Kludge around some wierness with generating our own
86			# URI interacting with cookies.
87			my $uri_str = "$proto://$host/$directory";
88			my $request = HTTP::Request->new("GET" => $uri_str) \|\|
89			&{$ht_lose}("HTTP::Request create failure");
90			my $uri = $request->uri();
91			$uri->port($port) if(defined($port));
92
93			my $response = $user_agent->request($request) \|\|
94			&{$ht_lose}("UserAgent request failure");
95
96			unless($response->is_success) {
97			&{$ht_lose}("Request failed:", $response->message);
98			}
99
100			my $strref = $response->content_ref;
101	dpavlin	1.4	if(!$nozero && length($$strref) == 0) {
102	dpavlin	1.1	&{$ht_lose}("Empty document");
103			}
104
105			if(defined($regex)) {
106			my $winning;
107			map {$winning++ if(/$regex/);} split("\n", $$strref);
108	dpavlin	1.4	if($invert) {
109	dpavlin	1.1	&{$ht_lose}("Failure regex matches:", $winning) if($winning);
110			} elsif(!$winning) {
111			&{$ht_lose}("Regex not found");
112			}
113			}
114	dpavlin	1.2	push(@available, $host);
115	dpavlin	1.1	}
116			if(@failed) {
117			print "$u_proto Failures: " . join(" ", @failed) . "\n";
118			foreach my $fail (@failed) {
119			print "$fail: $failure{$fail}\n";
120			}
121	dpavlin	1.4	if ($one && ($#available+1) > 0) {
122	dpavlin	1.2	print "$u_proto Available: ".join(" ", @available)."\n";
123			} else {
124			exit(1);
125			}
126	dpavlin	1.1	}
127			exit;
128			}
129
130			sub lose {
131			die join(" ", @_);
132			}
133
134			sub do_usage {
135
136			my $base = basename $0;
137			print STDERR "Usage: $base [options...] hosts ...\n";
138	dpavlin	1.4	if($extended_help) {
139	dpavlin	1.1	print <<'EOF';
140	dpavlin	1.4	-h Help. You're reading it.
141			-d\|--url URL URL to test on the remote host. Default is /.
142			-p\|--port PORT Port to connect to. Default is proto specific.
143			-P\|--proto PROTO Protocol to fetch. Default is http.
144			-s\|--https Fetch via https. Equivalent to -P https.
145			-t\|--timeout TIMEOUT Timeout for the fetch. Default is 60 seconds.
146			-r\|--regex REGEX A regexp that the retrieved content must match.
147			-v\|--invert Invert the regular expression. Content must NOT match.
148			-z\|--nozero Supress zero-length check.
149			-c\|--cookies Enable Cookies.
150			-o\|--one Return success if at least One server is available.
151			--envproxy User proxy server from env http_proxy and friends.
152			--proxy PROXY Set proxy explicitly
153	dpavlin	1.1	EOF
154			}
155			exit 1;
156			}
157
158			###
159
160	dpavlin	1.4	GetOptions(
161			'url\|d=s' => \$directory,
162			'port\|p=i' => \$port,
163			'timeout\|t=i' => \$timeout,
164			'regex\|r=s' => \$regex,
165			'https\|s=s' => sub { $proto = "https" },
166			'proto\|P=s' => \$proto,
167			'invert\|v' => \$invert,
168			'nozero\|z' => \$nozero,
169			'cookies\|c' => \$cookies,
170			'one\|o' => \$one,
171			'envproxy' => \$envproxy,
172			'proxy=s' => \$proxy,
173			'help\|h' => \$extended_help
174			) \|\| do_usage();
175	dpavlin	1.1
176			&main(@ARGV);
177
178			# EOF