summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/modules/cgi.t
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 06:33:51 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 06:33:51 +0000
commit4f0770f3df78ecd5dcaefbd214f7a1415366bca6 (patch)
tree72661b8f81594b855bcc967b819263f63fa30e17 /debian/perl-framework/t/modules/cgi.t
parentAdding upstream version 2.4.56. (diff)
downloadapache2-4f0770f3df78ecd5dcaefbd214f7a1415366bca6.tar.xz
apache2-4f0770f3df78ecd5dcaefbd214f7a1415366bca6.zip
Adding debian version 2.4.56-1~deb11u2.debian/2.4.56-1_deb11u2debian
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/perl-framework/t/modules/cgi.t')
-rw-r--r--debian/perl-framework/t/modules/cgi.t279
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;