diff options
Diffstat (limited to 'debian/perl-framework/t/modules/cgi.t')
| -rw-r--r-- | debian/perl-framework/t/modules/cgi.t | 279 |
1 files changed, 279 insertions, 0 deletions
diff --git a/debian/perl-framework/t/modules/cgi.t b/debian/perl-framework/t/modules/cgi.t new file mode 100644 index 0000000..9b6edc2 --- /dev/null +++ b/debian/perl-framework/t/modules/cgi.t @@ -0,0 +1,279 @@ +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; |