/[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.1 - (show annotations)
Mon Sep 2 13:59:54 2002 UTC (21 years, 7 months ago) by dpavlin
Branch: MAIN
import of original lwp-http.mon by Daniel Hagerty

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 use strict;
11
12 use LWP::UserAgent;
13 use HTTP::Cookies;
14 use HTTP::Request;
15 use Getopt::Std;
16 use File::Basename;
17 use URI;
18
19 ###
20
21 use vars qw($opt_h $opt_p $opt_t $opt_z $opt_d $opt_r $opt_s $opt_P
22 $opt_v $opt_c);
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
37 my $version = "0.1";
38 my $agent = "Yet Another Monitor Bot/$version";
39
40 my $u_proto;
41
42 ###
43
44 sub main {
45 do_usage() if(@_ == 0);
46
47 $directory = $opt_d if($opt_d);
48 $port = $opt_p if($opt_p);
49 $timeout = $opt_t if($opt_t);
50 $regex = $opt_r if($opt_r);
51 $proto = "https" if ($opt_s);
52 $proto = $opt_P if($opt_P);
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
62 my @failed;
63 my %failure;
64 host:
65 foreach my $host (@_) {
66 my $ht_lose = sub {
67 push(@failed, $host);
68 $failure{$host} = join(" ", @_);
69
70 # This generates a warning.
71 next host;
72 };
73
74 if($opt_c) {
75 # Generate new cookies for each host.
76 my $cookies = HTTP::Cookies->new() ||
77 &{$ht_lose}("HTTP::Cookies create failure");
78
79 $user_agent->cookie_jar($cookies);
80 }
81
82 # XXX Kludge around some wierness with generating our own
83 # URI interacting with cookies.
84 my $uri_str = "$proto://$host/$directory";
85 my $request = HTTP::Request->new("GET" => $uri_str) ||
86 &{$ht_lose}("HTTP::Request create failure");
87 my $uri = $request->uri();
88 $uri->port($port) if(defined($port));
89
90 my $response = $user_agent->request($request) ||
91 &{$ht_lose}("UserAgent request failure");
92
93 unless($response->is_success) {
94 &{$ht_lose}("Request failed:", $response->message);
95 }
96
97 my $strref = $response->content_ref;
98 if(!$opt_z && length($$strref) == 0) {
99 &{$ht_lose}("Empty document");
100 }
101
102 if(defined($regex)) {
103 my $winning;
104 map {$winning++ if(/$regex/);} split("\n", $$strref);
105 if($opt_v) {
106 &{$ht_lose}("Failure regex matches:", $winning) if($winning);
107 } elsif(!$winning) {
108 &{$ht_lose}("Regex not found");
109 }
110 }
111 }
112 if(@failed) {
113 print "$u_proto Failures: " . join(" ", @failed) . "\n";
114 foreach my $fail (@failed) {
115 print "$fail: $failure{$fail}\n";
116 }
117 exit(1);
118 }
119 exit;
120 }
121
122 sub lose {
123 die join(" ", @_);
124 }
125
126 sub do_usage {
127 my $extended = shift;
128
129 my $base = basename $0;
130 print STDERR "Usage: $base [options...] hosts ...\n";
131 if($extended) {
132 print <<'EOF';
133 -h Help. You're reading it.
134 -d URL URL to test on the remote host. Default is /.
135 -p PORT Port to connect to. Default is proto specific.
136 -P PROTO Protocol to fetch. Default is http.
137 -s Fetch via https. Equivalent to -P https.
138 -t TIMEOUT Timeout for the fetch. Default is 60 seconds.
139 -r REGEX A regular expression that the retrieved content must match.
140 -v Invert the regular expression. Content must NOT match.
141 -z Supress zero-length check.
142 -c Enable Cookies.
143 EOF
144 }
145 exit 1;
146 }
147
148 ###
149
150 getopts("hszvcp:t:d:r:P:") || do_usage();
151 do_usage($opt_h) if($opt_h);
152
153 &main(@ARGV);
154
155 # EOF

  ViewVC Help
Powered by ViewVC 1.1.26