/[mon-modules]/lwp-http.mon
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /lwp-http.mon

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Mon Jun 23 21:48:53 2003 UTC (15 years, 11 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +45 -34 lines
added long command-line options and proxy support

1 #!/usr/local/bin/perl
2 #
3 # 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 #
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
15 use strict;
16
17 use LWP::UserAgent;
18 use HTTP::Cookies;
19 use HTTP::Request;
20 use Getopt::Long qw(:config pass_through); # leave ARGV
21 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 my $invert;
37 my $nozero;
38 my $one;
39 my $envproxy;
40 my $proxy;
41 my $cookies;
42 my $extended_help;
43
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 do_usage() if(! @_);
53
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 $user_agent->proxy(['http', 'ftp'], $proxy) if ($proxy);
62 $user_agent->env_proxy() if ($envproxy);
63
64 my @failed;
65 my @available;
66 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 if($cookies) {
78 # 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 if(!$nozero && length($$strref) == 0) {
102 &{$ht_lose}("Empty document");
103 }
104
105 if(defined($regex)) {
106 my $winning;
107 map {$winning++ if(/$regex/);} split("\n", $$strref);
108 if($invert) {
109 &{$ht_lose}("Failure regex matches:", $winning) if($winning);
110 } elsif(!$winning) {
111 &{$ht_lose}("Regex not found");
112 }
113 }
114 push(@available, $host);
115 }
116 if(@failed) {
117 print "$u_proto Failures: " . join(" ", @failed) . "\n";
118 foreach my $fail (@failed) {
119 print "$fail: $failure{$fail}\n";
120 }
121 if ($one && ($#available+1) > 0) {
122 print "$u_proto Available: ".join(" ", @available)."\n";
123 } else {
124 exit(1);
125 }
126 }
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 if($extended_help) {
139 print <<'EOF';
140 -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 EOF
154 }
155 exit 1;
156 }
157
158 ###
159
160 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
176 &main(@ARGV);
177
178 # EOF

  ViewVC Help
Powered by ViewVC 1.1.26