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