/[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

Annotation of /lwp-http.mon

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide 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 dpavlin 1.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 dpavlin 1.2 #
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 dpavlin 1.1
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 dpavlin 1.2 $opt_v $opt_c $opt_o);
27 dpavlin 1.1
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 dpavlin 1.3 $user_agent->env_proxy();
66 dpavlin 1.1
67     my @failed;
68 dpavlin 1.2 my @available;
69 dpavlin 1.1 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 dpavlin 1.2 push(@available, $host);
118 dpavlin 1.1 }
119     if(@failed) {
120     print "$u_proto Failures: " . join(" ", @failed) . "\n";
121     foreach my $fail (@failed) {
122     print "$fail: $failure{$fail}\n";
123     }
124 dpavlin 1.2 if ($opt_o && ($#available+1) > 0) {
125     print "$u_proto Available: ".join(" ", @available)."\n";
126     } else {
127     exit(1);
128     }
129 dpavlin 1.1 }
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 dpavlin 1.2 -o Return success if at least One server is available.
155 dpavlin 1.1 EOF
156     }
157     exit 1;
158     }
159    
160     ###
161    
162 dpavlin 1.2 getopts("hszvcp:t:d:r:P:o") || do_usage();
163 dpavlin 1.1 do_usage($opt_h) if($opt_h);
164    
165     &main(@ARGV);
166    
167     # EOF

  ViewVC Help
Powered by ViewVC 1.1.26