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.
56 my %options = (debug => 0,
59 ip_addr => '127.0.0.1',
60 apache_conf => '/etc/apache2/sites-enabled/*',
64 'debug|d+','help|h|?','man|m',
66 'apache_conf|apache-conf=s',
69 pod2usage() if $options{help};
70 pod2usage({verbose=>2}) if $options{man};
72 $DEBUG = $options{debug};
76 # push @USAGE_ERRORS,"You must pass something";
79 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
81 my @conf_files = glob($options{apache_conf});
85 {package SITE_TESTER::http;
88 use LWP::Protocol::http;
89 require LWP::MemberMixin;
90 use base qw(LWP::Protocol::http);
92 my($self, $host, $port, $timeout) = @_;
93 $host = $self->{ua}{____special_host};
94 return $self->SUPER::_new_socket($host,$port,$timeout);
97 return "LWP::Protocol::http::Socket";
101 # parse the conf_files
103 for my $conf_file (@conf_files) {
104 next unless -r $conf_file;
105 my $fh = IO::File->new($conf_file,'r');
108 next unless /^\s*ServerName\s(\S+)/;
113 my $mech = WWW::Mechanize->new(autocheck => 1);
114 $mech->{____special_host} = $options{ip_addr};
115 LWP::Protocol::implementor('http','SITE_TESTER::http');
117 for my $site (sort keys %sites) {
118 $mech->get("http://$site/");
119 print "site $site [$options{ip_addr}]: ".$mech->status()."\n";
120 # print $mech->content();
121 # for my $header ($mech->response->header_field_names) {
122 # print $header.': '.$mech->response->header($header)."\n";