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

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