/[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.2 - (show annotations)
Mon Sep 2 14:20:14 2002 UTC (19 years, 1 month ago) by dpavlin
Branch: MAIN
Changes since 1.1: +14 -3 lines
added -o option

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
66 my @failed;
67 my @available;
68 my %failure;
69 host:
70 foreach my $host (@_) {
71 my $ht_lose = sub {
72 push(@failed, $host);
73 $failure{$host} = join(" ", @_);
74
75 # This generates a warning.
76 next host;
77 };
78
79 if($opt_c) {
80 # Generate new cookies for each host.
81 my $cookies = HTTP::Cookies->new() ||
82 &{$ht_lose}("HTTP::Cookies create failure");
83
84 $user_agent->cookie_jar($cookies);
85 }
86
87 # XXX Kludge around some wierness with generating our own
88 # URI interacting with cookies.
89 my $uri_str = "$proto://$host/$directory";
90 my $request = HTTP::Request->new("GET" => $uri_str) ||
91 &{$ht_lose}("HTTP::Request create failure");
92 my $uri = $request->uri();
93 $uri->port($port) if(defined($port));
94
95 my $response = $user_agent->request($request) ||
96 &{$ht_lose}("UserAgent request failure");
97
98 unless($response->is_success) {
99 &{$ht_lose}("Request failed:", $response->message);
100 }
101
102 my $strref = $response->content_ref;
103 if(!$opt_z && length($$strref) == 0) {
104 &{$ht_lose}("Empty document");
105 }
106
107 if(defined($regex)) {
108 my $winning;
109 map {$winning++ if(/$regex/);} split("\n", $$strref);
110 if($opt_v) {
111 &{$ht_lose}("Failure regex matches:", $winning) if($winning);
112 } elsif(!$winning) {
113 &{$ht_lose}("Regex not found");
114 }
115 }
116 push(@available, $host);
117 }
118 if(@failed) {
119 print "$u_proto Failures: " . join(" ", @failed) . "\n";
120 foreach my $fail (@failed) {
121 print "$fail: $failure{$fail}\n";
122 }
123 if ($opt_o && ($#available+1) > 0) {
124 print "$u_proto Available: ".join(" ", @available)."\n";
125 } else {
126 exit(1);
127 }
128 }
129 exit;
130 }
131
132 sub lose {
133 die join(" ", @_);
134 }
135
136 sub do_usage {
137 my $extended = shift;
138
139 my $base = basename $0;
140 print STDERR "Usage: $base [options...] hosts ...\n";
141 if($extended) {
142 print <<'EOF';
143 -h Help. You're reading it.
144 -d URL URL to test on the remote host. Default is /.
145 -p PORT Port to connect to. Default is proto specific.
146 -P PROTO Protocol to fetch. Default is http.
147 -s Fetch via https. Equivalent to -P https.
148 -t TIMEOUT Timeout for the fetch. Default is 60 seconds.
149 -r REGEX A regular expression that the retrieved content must match.
150 -v Invert the regular expression. Content must NOT match.
151 -z Supress zero-length check.
152 -c Enable Cookies.
153 -o Return success if at least One server is available.
154 EOF
155 }
156 exit 1;
157 }
158
159 ###
160
161 getopts("hszvcp:t:d:r:P:o") || do_usage();
162 do_usage($opt_h) if($opt_h);
163
164 &main(@ARGV);
165
166 # EOF

  ViewVC Help
Powered by ViewVC 1.1.26