101 lines
3.6 KiB
Perl
101 lines
3.6 KiB
Perl
package HTML::Perlinfo::Apache;
|
|
|
|
use warnings;
|
|
use strict;
|
|
use HTML::Perlinfo::Common;
|
|
|
|
|
|
|
|
sub new {
|
|
my %apache;
|
|
my $env = ( $ENV{SERVER_SOFTWARE} || "" ) =~ /apache/i;
|
|
my $mp = exists $ENV{MOD_PERL};
|
|
$apache{'env'} = $env;
|
|
$apache{'mp'} = $mp;
|
|
bless \%apache;
|
|
}
|
|
|
|
sub has {
|
|
my ( $self, @opts ) = @_;
|
|
for my $opt (@opts) {
|
|
return 0 unless $self->{$opt};
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub print_apache {
|
|
|
|
my $self = shift;
|
|
my @mods;
|
|
my ($version, $hostname, $port, $mp_status) = ("<i>Not detected</i>") x 7;
|
|
|
|
$mp_status = 'enabled' if $self->has qw(mp);
|
|
|
|
($version) = $ENV{'SERVER_SOFTWARE'} =~ /(\d+[\.\d]*)/
|
|
if (defined $ENV{'SERVER_SOFTWARE'} && $ENV{'SERVER_SOFTWARE'} =~ /\d+[\.\d]*/);
|
|
|
|
|
|
return join '', print_table_row(2, "Apache Version", "$version"),
|
|
(defined($ENV{'SERVER_NAME'}) && defined($ENV{'SERVER_PORT'})) ?
|
|
print_table_row(2, "Hostname:Port", "$ENV{'SERVER_NAME'} : $ENV{'SERVER_PORT'}"):
|
|
print_table_row(2, "Hostname:Port", "$hostname : $port"),
|
|
print_table_row(2, "mod_perl", "$mp_status");
|
|
}
|
|
|
|
sub print_modperl {
|
|
|
|
my ($version_status, $version_number) = ("<i>Not detected</i>") x 3;
|
|
|
|
$version_status = '1.0';
|
|
$version_status = '2.0 or higher' if $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2;
|
|
($version_number) = $ENV{MOD_PERL} =~ /^\S+\/(\d+(?:[\.\_]\d+)+)/;
|
|
$version_number =~ s/_//g;
|
|
$version_number =~ s/(\.[^.]+)\./$1/g;
|
|
unless ($version_status eq '2.0 or higher') {
|
|
if ( $version_number >= 1.9901 ) {
|
|
$version_status = '1.9 which is incompatible with 2.0';
|
|
}
|
|
}
|
|
|
|
return join '', print_box_start(0),
|
|
"Running under mod_perl version $version_status (version number: $version_number)",
|
|
print_box_end();
|
|
|
|
}
|
|
|
|
sub print_apache_environment {
|
|
|
|
|
|
return join '', print_table_row(2, "DOCUMENT_ROOT", $ENV{'DOCUMENT_ROOT'}),
|
|
print_table_row(2, "HTTP_ACCEPT", $ENV{'HTTP_ACCEPT'}),
|
|
print_table_row(2, "HTTP_ACCEPT_CHARSET", $ENV{'HTTP_ACCEPT_CHARSET'}),
|
|
print_table_row(2, "HTTP_ACCEPT_ENCODING", $ENV{'HTTP_ACCEPT_ENCODING'}),
|
|
print_table_row(2, "HTTP_ACCEPT_LANGUAGE", $ENV{'HTTP_ACCEPT_LANGUAGE'}),
|
|
print_table_row(2, "HTTP_CONNECTION", $ENV{'HTTP_CONNECTION'}),
|
|
print_table_row(2, "HTTP_HOSTS", $ENV{'HTTP_HOSTS'}),
|
|
print_table_row(2, "HTTP_KEEP_ALIVE", $ENV{'HTTP_KEEP_ALIVE'}),
|
|
print_table_row(2, "HTTP_USER_AGENT", $ENV{'HTTP_USER_AGENT'}),
|
|
print_table_row(2, "PATH", $ENV{'PATH'}),
|
|
print_table_row(2, "REMOTE_ADDR", $ENV{'REMOTE_ADDR'}),
|
|
print_table_row(2, "REMOTE_HOST", $ENV{'REMOTE_HOST'}),
|
|
print_table_row(2, "REMOTE_PORT", $ENV{'REMOTE_PORT'}),
|
|
print_table_row(2, "SCRIPT_FILENAME", $ENV{'SCRIPT_FILENAME'}),
|
|
print_table_row(2, "SCRIPT_URI", $ENV{'SCRIPT_URI'}),
|
|
print_table_row(2, "SCRIPT_URL", $ENV{'SCRIPT_URL'}),
|
|
print_table_row(2, "SERVER_ADDR", $ENV{'SERVER_ADDR'}),
|
|
print_table_row(2, "SERVER_ADMIN", $ENV{'SERVER_ADMIN'}),
|
|
print_table_row(2, "SERVER_NAME", $ENV{'SERVER_NAME'}),
|
|
print_table_row(2, "SERVER_PORT", $ENV{'SERVER_PORT'}),
|
|
print_table_row(2, "SERVER_SIGNATURE", $ENV{'SERVER_SIGNATURE'}),
|
|
print_table_row(2, "SERVER_SOFTWARE", $ENV{'SERVER_SOFTWARE'}),
|
|
print_table_row(2, "GATEWAY_INTERFACE", $ENV{'GATEWAY_INTERFACE'}),
|
|
print_table_row(2, "SERVER_PROTOCOL", $ENV{'SERVER_PROTOCOL'}),
|
|
print_table_row(2, "REQUEST_METHOD", $ENV{'REQUEST_METHOD'}),
|
|
print_table_row(2, "QUERY_STRING", $ENV{'QUERY_STRING'}),
|
|
print_table_row(2, "REQUEST_URI", $ENV{'REQUEST_URI'}),
|
|
print_table_row(2, "SCRIPT_NAME", $ENV{'SCRIPT_NAME'});
|
|
|
|
}
|
|
1;
|
|
|