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

  ViewVC Help
Powered by ViewVC 1.1.26