/[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.3 - (show annotations)
Fri Mar 7 16:08:34 2003 UTC (18 years, 7 months ago) by dpavlin
Branch: MAIN
Changes since 1.2: +1 -0 lines
use proxy servers from enviroment variables

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

  ViewVC Help
Powered by ViewVC 1.1.26