279 lines
7.4 KiB
Perl
279 lines
7.4 KiB
Perl
use strict;
|
|
use warnings FATAL => 'all';
|
|
|
|
use Apache::Test;
|
|
use Apache::TestRequest;
|
|
use Apache::TestUtil;
|
|
use File::stat;
|
|
|
|
my $have_apache_2 = have_apache 2;
|
|
my $have_apache_2050 = have_min_apache_version "2.0.50";
|
|
|
|
my $script_log_length = 40960;
|
|
|
|
## mod_cgi test
|
|
##
|
|
## extra.conf.in:
|
|
## <IfModule mod_cgi.c>
|
|
## AddHandler cgi-script .sh
|
|
## AddHandler cgi-script .pl
|
|
## ScriptLog logs/mod_cgi.log
|
|
## ScriptLogLength 40960
|
|
## ScriptLogBuffer 256
|
|
## <Directory @SERVERROOT@/htdocs/modules/cgi>
|
|
## Options +ExecCGI
|
|
## [some AcceptPathInfo stuff]
|
|
## </Directory>
|
|
## </IfModule>
|
|
##
|
|
|
|
my @post_content = (10, 99, 250, 255, 256, 257, 258, 1024);
|
|
|
|
my %test = (
|
|
'perl.pl' => {
|
|
'rc' => 200,
|
|
'expect' => 'perl cgi'
|
|
},
|
|
'bogus-perl.pl' => {
|
|
'rc' => 500,
|
|
'expect' => 'none'
|
|
},
|
|
'nph-test.pl' => {
|
|
'rc' => 200,
|
|
'expect' => 'ok'
|
|
},
|
|
'sh.sh' => {
|
|
'rc' => 200,
|
|
'expect' => 'sh cgi'
|
|
},
|
|
'bogus-sh.sh' => {
|
|
'rc' => 500,
|
|
'expect' => 'none'
|
|
},
|
|
'acceptpathinfoon.sh' => {
|
|
'rc' => 200,
|
|
'expect' => ''
|
|
},
|
|
'acceptpathinfoon.sh/foo' => {
|
|
'rc' => 200,
|
|
'expect' => '/foo'
|
|
},
|
|
'acceptpathinfooff.sh' => {
|
|
'rc' => 200,
|
|
'expect' => ''
|
|
},
|
|
'acceptpathinfooff.sh/foo' => {
|
|
'rc' => 404,
|
|
'expect' => 'none'
|
|
},
|
|
'acceptpathinfodefault.sh' => {
|
|
'rc' => 200,
|
|
'expect' => ''
|
|
},
|
|
'acceptpathinfodefault.sh/foo' => {
|
|
'rc' => 200,
|
|
'expect' => '/foo'
|
|
},
|
|
'stderr1.pl' => {
|
|
'rc' => 200,
|
|
'expect' => 'this is stdout'
|
|
},
|
|
'stderr2.pl' => {
|
|
'rc' => 200,
|
|
'expect' => 'this is also stdout'
|
|
},
|
|
'stderr3.pl' => {
|
|
'rc' => 200,
|
|
'expect' => 'this is more stdout'
|
|
},
|
|
'nph-stderr.pl' => {
|
|
'rc' => 200,
|
|
'expect' => 'this is nph-stdout'
|
|
},
|
|
);
|
|
|
|
#XXX: find something that'll on other platforms (/bin/sh aint it)
|
|
if (Apache::TestConfig::WINFU()) {
|
|
delete @test{qw(sh.sh bogus-sh.sh)};
|
|
}
|
|
if (Apache::TestConfig::WINFU() || !$have_apache_2) {
|
|
delete @test{qw(acceptpathinfoon.sh acceptpathinfoon.sh/foo)};
|
|
delete @test{qw(acceptpathinfooff.sh acceptpathinfooff.sh/foo)};
|
|
delete @test{qw(acceptpathinfodefault.sh acceptpathinfodefault.sh/foo)};
|
|
}
|
|
|
|
# CGI stderr handling works in 2.0.50 and later only on Unixes.
|
|
if (!$have_apache_2050 || Apache::TestConfig::WINFU()) {
|
|
delete @test{qw(stderr1.pl stderr2.pl stderr3.pl nph-stderr.pl)};
|
|
}
|
|
|
|
my $tests = ((keys %test) * 2) + (@post_content * 3) + 4;
|
|
plan tests => $tests, \&need_cgi;
|
|
|
|
my ($expected, $actual);
|
|
my $path = "/modules/cgi";
|
|
my $vars = Apache::Test::vars();
|
|
my $t_logs = $vars->{t_logs};
|
|
my $cgi_log = "$t_logs/mod_cgi.log";
|
|
my ($bogus,$log_size,$stat) = (0,0,0);
|
|
|
|
unlink $cgi_log if -e $cgi_log;
|
|
|
|
foreach (sort keys %test) {
|
|
$expected = $test{$_}{rc};
|
|
$actual = GET_RC "$path/$_";
|
|
ok t_cmp($actual,
|
|
$expected,
|
|
"return code for $_"
|
|
);
|
|
|
|
if ($test{$_}{expect} ne 'none') {
|
|
$expected = $test{$_}{expect};
|
|
$actual = GET_BODY "$path/$_";
|
|
chomp $actual if $actual =~ /\n$/;
|
|
|
|
ok t_cmp($actual,
|
|
$expected,
|
|
"body for $_"
|
|
);
|
|
}
|
|
elsif ($_ !~ /^bogus/) {
|
|
print "# no body test for this one\n";
|
|
ok 1;
|
|
}
|
|
|
|
## verify bogus cgi's get handled correctly
|
|
## logging to the cgi log
|
|
if ($_ =~ /^bogus/) {
|
|
$bogus++;
|
|
if ($bogus == 1) {
|
|
|
|
## make sure cgi log got created, get size.
|
|
if (-e $cgi_log) {
|
|
print "# cgi log created ok.\n";
|
|
ok 1;
|
|
$stat = stat($cgi_log);
|
|
$log_size = $$stat[7];
|
|
} else {
|
|
print "# error: cgi log not created!\n";
|
|
ok 0;
|
|
}
|
|
} else {
|
|
|
|
## make sure log got bigger.
|
|
if (-e $cgi_log) {
|
|
$stat = stat($cgi_log);
|
|
print "# checking that log size ($$stat[7]) is bigger than it used to be ($log_size)\n";
|
|
ok ($$stat[7] > $log_size);
|
|
$log_size = $$stat[7];
|
|
} else {
|
|
print "# error: cgi log does not exist!\n";
|
|
ok 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
## post lots of content to a bad cgi, so we can verify
|
|
## ScriptLogBuffer is working.
|
|
my $content = 0;
|
|
foreach my $length (@post_content) {
|
|
$content++;
|
|
$expected = '500';
|
|
$actual = POST_RC "$path/bogus-perl.pl", content => "$content"x$length;
|
|
|
|
print "# posted content (length $length) to bogus-perl.pl\n";
|
|
## should get rc 500
|
|
ok t_cmp($actual, $expected, "POST to $path/bogus-perl.pl [content: $content x $length]");
|
|
|
|
if (-e $cgi_log) {
|
|
## cgi log should be bigger.
|
|
## as long as it's under ScriptLogLength
|
|
$stat = stat($cgi_log);
|
|
if ($log_size < $script_log_length) {
|
|
print "# checking that log size ($$stat[7]) is greater than $log_size\n";
|
|
ok ($$stat[7] > $log_size);
|
|
} else {
|
|
## should not fall in here at this point,
|
|
## but just in case...
|
|
print "# verifying log did not increase in size...\n";
|
|
ok t_cmp($$stat[7], $log_size, "log size should not have increased");
|
|
}
|
|
$log_size = $$stat[7];
|
|
|
|
## there should be less than ScriptLogBuffer (256)
|
|
## characters logged from the post content
|
|
open (LOG, $cgi_log) or die "died opening cgi log: $!";
|
|
my $multiplier = 256;
|
|
my $log;
|
|
{
|
|
local $/;
|
|
$log = <LOG>;
|
|
}
|
|
close (LOG);
|
|
$multiplier = $length unless $length > $multiplier;
|
|
print "# verifying that logged content is $multiplier characters\n";
|
|
if ($log =~ /^(?:$content){$multiplier}\n?$/m) {
|
|
ok 1;
|
|
}
|
|
else {
|
|
$log =~ s{^}{# }m;
|
|
print "# no log line found with $multiplier '$content' characters\n";
|
|
print "# log is:\n'$log'\n";
|
|
ok 0;
|
|
}
|
|
} else {
|
|
## log does not exist ##
|
|
print "# cgi log does not exist, test fails.\n";
|
|
ok 0;
|
|
}
|
|
}
|
|
|
|
## make sure cgi log does not
|
|
## keep logging after it is bigger
|
|
## than ScriptLogLength
|
|
for (my $i=1 ; $i<=40 ; $i++) {
|
|
|
|
## get out if log does not exist ##
|
|
last unless -e $cgi_log;
|
|
|
|
## request the 1k bad cgi
|
|
## (1k of data logged per request)
|
|
GET_RC "$path/bogus1k.pl";
|
|
|
|
## when log goes over max size stop making requests
|
|
$stat = stat($cgi_log);
|
|
$log_size = $$stat[7];
|
|
last if ($log_size > $script_log_length);
|
|
|
|
}
|
|
## make sure its over (or equal) our ScriptLogLength
|
|
print "# verifying log is greater than $script_log_length bytes.\n";
|
|
ok ($log_size >= $script_log_length);
|
|
|
|
## make sure it does not grow now.
|
|
GET_RC "$path/bogus1k.pl";
|
|
print "# verifying log did not grow after making bogus request.\n";
|
|
if (-e $cgi_log) {
|
|
$stat = stat($cgi_log);
|
|
ok ($log_size eq $$stat[7]);
|
|
} else {
|
|
print "# log does not exist!\n";
|
|
ok 0;
|
|
}
|
|
|
|
GET_RC "$path/bogus-perl.pl";
|
|
print "# verifying log did not grow after making another bogus request.\n";
|
|
if (-e $cgi_log) {
|
|
$stat = stat($cgi_log);
|
|
ok ($log_size eq $$stat[7]);
|
|
} else {
|
|
print "# log does not exist!\n";
|
|
ok 0;
|
|
}
|
|
|
|
print "# checking that HEAD $path/perl.pl returns 200.\n";
|
|
ok HEAD_RC("$path/perl.pl") == 200;
|
|
|
|
## clean up
|
|
unlink $cgi_log;
|