2 # site_tester tests sites, and is released
3 # under the terms of the GPL version 2, or any later version, at your
4 # option. See the file README and COPYING for more information.
5 # Copyright 2009 by Don Armstrong <don@donarmstrong.com>.
6 # $Id: perl_script 1432 2009-04-21 02:42:41Z don $
17 site_tester - Test sites
24 --debug, -d debugging level (Default 0)
25 --help, -h display this help
26 --man, -m display manual
34 Debug verbosity. (Default 0)
38 Display brief usage information.
57 my %options = (debug => 0,
60 ip_addr => '127.0.0.1',
61 apache_conf => '/etc/apache2/sites-enabled/*',
65 'debug|d+','help|h|?','man|m',
67 'apache_conf|apache-conf=s',
70 pod2usage() if $options{help};
71 pod2usage({verbose=>2}) if $options{man};
73 $DEBUG = $options{debug};
77 # push @USAGE_ERRORS,"You must pass something";
80 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
82 my @conf_files = glob($options{apache_conf});
86 {package SITE_TESTER::http;
89 use LWP::Protocol::http;
90 require LWP::MemberMixin;
91 use base qw(LWP::Protocol::http);
93 my($self, $host, $port, $timeout) = @_;
94 $host = $self->{ua}{____special_host};
95 return $self->SUPER::_new_socket($host,$port,$timeout);
98 return "LWP::Protocol::http::Socket";
102 # parse the conf_files
104 for my $conf_file (@conf_files) {
105 next unless -r $conf_file;
106 my $fh = IO::File->new($conf_file,'r');
109 next unless /^\s*ServerName\s(\S+)/;
114 my $mech = WWW::Mechanize->new(autocheck => 0);
115 $mech->{____special_host} = $options{ip_addr};
116 LWP::Protocol::implementor('http','SITE_TESTER::http');
118 for my $site (sort keys %sites) {
119 $mech->get("http://$site/");
120 print "site $site [$options{ip_addr}]: ".$mech->status()."\n";
121 # print $mech->content();
122 # for my $header ($mech->response->header_field_names) {
123 # print $header.': '.$mech->response->header($header)."\n";