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

Diff of /lwp-http.mon

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by dpavlin, Fri Mar 7 16:08:34 2003 UTC revision 1.4 by dpavlin, Mon Jun 23 21:48:53 2003 UTC
# Line 1  Line 1 
1  #!/usr/local/bin/perl  #!/usr/local/bin/perl
2    #
3  # File:         lwp-http.mon  # File:         lwp-http.mon
4  # Author:       Daniel Hagerty, hag@linnaean.org  # Author:       Daniel Hagerty, hag@linnaean.org
5  # Date:         Sun Mar 19 22:06:02 2000  # Date:         Sun Mar 19 22:06:02 2000
# Line 16  use strict; Line 17  use strict;
17  use LWP::UserAgent;  use LWP::UserAgent;
18  use HTTP::Cookies;  use HTTP::Cookies;
19  use HTTP::Request;  use HTTP::Request;
20  use Getopt::Std;  use Getopt::Long qw(:config pass_through);      # leave ARGV
21  use File::Basename;  use File::Basename;
22  use URI;  use URI;
23    
24  ###  ###
25    
 use vars qw($opt_h $opt_p $opt_t $opt_z $opt_d $opt_r $opt_s $opt_P  
         $opt_v $opt_c $opt_o);  
   
 ##  
   
26  # Configure this.  # Configure this.
27  my $maintainer = 'youremailhere@localhost';  my $maintainer = 'youremailhere@localhost';
28    
# Line 37  my $directory; Line 33  my $directory;
33  my $regex;  my $regex;
34  my $proto = "http";  my $proto = "http";
35  my $timeout = 60;  my $timeout = 60;
36    my $invert;
37    my $nozero;
38    my $one;
39    my $envproxy;
40    my $proxy;
41    my $cookies;
42    my $extended_help;
43    
44  my $version = "0.1";  my $version = "0.1";
45  my $agent = "Yet Another Monitor Bot/$version";  my $agent = "Yet Another Monitor Bot/$version";
# Line 46  my $u_proto; Line 49  my $u_proto;
49  ###  ###
50    
51  sub main {  sub main {
52      do_usage() if(@_ == 0);      do_usage() if(! @_);
   
     $directory = $opt_d if($opt_d);  
     $port = $opt_p if($opt_p);  
     $timeout = $opt_t if($opt_t);  
     $regex = $opt_r if($opt_r);  
     $proto = "https" if ($opt_s);  
     $proto = $opt_P if($opt_P);  
53    
54      $directory =~ s/^\///;      # Nuke leading slash      $directory =~ s/^\///;      # Nuke leading slash
55      $u_proto = $proto; $u_proto =~ tr/[a-z]/[A-Z]/;      $u_proto = $proto; $u_proto =~ tr/[a-z]/[A-Z]/;
# Line 62  sub main { Line 58  sub main {
58      $user_agent->agent($agent);      $user_agent->agent($agent);
59      $user_agent->from($maintainer);      $user_agent->from($maintainer);
60      $user_agent->timeout($timeout);      $user_agent->timeout($timeout);
61      $user_agent->env_proxy();      $user_agent->proxy(['http', 'ftp'], $proxy) if ($proxy);
62        $user_agent->env_proxy() if ($envproxy);
63    
64      my @failed;      my @failed;
65      my @available;      my @available;
# Line 77  sub main { Line 74  sub main {
74              next host;              next host;
75          };          };
76    
77          if($opt_c) {          if($cookies) {
78              # Generate new cookies for each host.              # Generate new cookies for each host.
79              my $cookies = HTTP::Cookies->new() ||              my $cookies = HTTP::Cookies->new() ||
80                  &{$ht_lose}("HTTP::Cookies create failure");                  &{$ht_lose}("HTTP::Cookies create failure");
# Line 101  sub main { Line 98  sub main {
98          }          }
99    
100          my $strref = $response->content_ref;          my $strref = $response->content_ref;
101          if(!$opt_z && length($$strref) == 0) {          if(!$nozero && length($$strref) == 0) {
102              &{$ht_lose}("Empty document");              &{$ht_lose}("Empty document");
103          }          }
104    
105          if(defined($regex)) {          if(defined($regex)) {
106              my $winning;              my $winning;
107              map {$winning++ if(/$regex/);} split("\n", $$strref);              map {$winning++ if(/$regex/);} split("\n", $$strref);
108              if($opt_v) {              if($invert) {
109                  &{$ht_lose}("Failure regex matches:", $winning) if($winning);                  &{$ht_lose}("Failure regex matches:", $winning) if($winning);
110              } elsif(!$winning) {              } elsif(!$winning) {
111                  &{$ht_lose}("Regex not found");                  &{$ht_lose}("Regex not found");
# Line 121  sub main { Line 118  sub main {
118          foreach my $fail (@failed) {          foreach my $fail (@failed) {
119              print "$fail: $failure{$fail}\n";              print "$fail: $failure{$fail}\n";
120          }          }
121          if ($opt_o && ($#available+1) > 0) {          if ($one && ($#available+1) > 0) {
122                  print "$u_proto Available: ".join(" ", @available)."\n";                  print "$u_proto Available: ".join(" ", @available)."\n";
123          } else {          } else {
124                  exit(1);                  exit(1);
# Line 135  sub lose { Line 132  sub lose {
132  }  }
133    
134  sub do_usage {  sub do_usage {
     my $extended = shift;  
135    
136      my $base = basename $0;      my $base = basename $0;
137      print STDERR "Usage: $base [options...] hosts ...\n";      print STDERR "Usage: $base [options...] hosts ...\n";
138      if($extended) {      if($extended_help) {
139          print <<'EOF';          print <<'EOF';
140  -h              Help.  You're reading it.  -h                      Help.  You're reading it.
141  -d URL          URL to test on the remote host.  Default is /.  -d|--url URL            URL to test on the remote host.  Default is /.
142  -p PORT         Port to connect to.  Default is proto specific.  -p|--port PORT          Port to connect to.  Default is proto specific.
143  -P PROTO        Protocol to fetch.  Default is http.  -P|--proto PROTO        Protocol to fetch.  Default is http.
144  -s              Fetch via https.  Equivalent to -P https.  -s|--https              Fetch via https.  Equivalent to -P https.
145  -t TIMEOUT      Timeout for the fetch.  Default is 60 seconds.  -t|--timeout TIMEOUT    Timeout for the fetch.  Default is 60 seconds.
146  -r REGEX        A regular expression that the retrieved content must match.  -r|--regex REGEX        A regexp that the retrieved content must match.
147  -v              Invert the regular expression.  Content must NOT match.  -v|--invert             Invert the regular expression.  Content must NOT match.
148  -z              Supress zero-length check.  -z|--nozero             Supress zero-length check.
149  -c              Enable Cookies.  -c|--cookies            Enable Cookies.
150  -o              Return success if at least One server is available.  -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  EOF  EOF
154      }      }
155      exit 1;      exit 1;
# Line 159  EOF Line 157  EOF
157    
158  ###  ###
159    
160  getopts("hszvcp:t:d:r:P:o") || do_usage();  GetOptions(
161  do_usage($opt_h) if($opt_h);          '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    
176  &main(@ARGV);  &main(@ARGV);
177    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.26