summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/apache/limits.t
diff options
context:
space:
mode:
Diffstat (limited to 'debian/perl-framework/t/apache/limits.t')
-rw-r--r--debian/perl-framework/t/apache/limits.t215
1 files changed, 215 insertions, 0 deletions
diff --git a/debian/perl-framework/t/apache/limits.t b/debian/perl-framework/t/apache/limits.t
new file mode 100644
index 0000000..124f731
--- /dev/null
+++ b/debian/perl-framework/t/apache/limits.t
@@ -0,0 +1,215 @@
+#
+# Test the LimitRequestLine, LimitRequestFieldSize, LimitRequestFields,
+# and LimitRequestBody directives.
+#
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+#
+# These values are chosen to exceed the limits in extra.conf, namely:
+#
+# LimitRequestLine 128
+# LimitRequestFieldSize 1024
+# LimitRequestFields 32
+# <Directory @SERVERROOT@/htdocs/apache/limits>
+# LimitRequestBody 65536
+# </Directory>
+#
+
+my @conditions = qw(requestline fieldsize fieldcount bodysize merged_fieldsize);
+
+my %params = ('requestline-succeed' => "/apache/limits/",
+ 'requestline-fail' => ("/apache/limits/" . ('a' x 256)),
+ 'fieldsize-succeed' => 'short value',
+ 'fieldsize-fail' => ('a' x 2048),
+ 'fieldcount-succeed' => 1,
+ 'fieldcount-fail' => 64,
+ 'bodysize-succeed' => ('a' x 1024),
+ 'bodysize-fail' => ('a' x 131072),
+ 'merged_fieldsize-succeed' => ('a' x 500),
+ 'merged_fieldsize-fail' => ('a' x 600),
+ );
+my %xrcs = ('requestline-succeed' => 200,
+ 'requestline-fail' => 414,
+ 'fieldsize-succeed' => 200,
+ 'fieldsize-fail' => 400,
+ 'fieldcount-succeed' => 200,
+ 'fieldcount-fail' => 400,
+ 'bodysize-succeed' => 200,
+ 'bodysize-fail' => 413,
+ 'merged_fieldsize-succeed' => 200,
+ 'merged_fieldsize-fail' => 400,
+ );
+
+my $res;
+
+if (!have_min_apache_version("2.2.32")) {
+ $xrcs{"merged_fieldsize-fail"} = 200;
+}
+
+#
+# Two tests for each of the conditions, plus two more for the
+# chunked version of the body-too-large test IFF we have the
+# appropriate level of LWP support.
+#
+
+my $no_chunking = defined($LWP::VERSION) && $LWP::VERSION < 5.60;
+if ($no_chunking) {
+ print "# Chunked upload tests will NOT be performed;\n",
+ "# LWP 5.60 or later is required and you only have ",
+ "$LWP::VERSION installed.\n";
+}
+
+my $subtests = (@conditions * 2) + 2;
+plan tests => $subtests, \&need_lwp;
+
+use vars qw($expected_rc);
+
+my $testnum = 1;
+foreach my $cond (@conditions) {
+ foreach my $goodbad (qw(succeed fail)) {
+ my $param = $params{"$cond-$goodbad"};
+ $expected_rc = $xrcs{"$cond-$goodbad"};
+ my $resp;
+ if ($cond eq 'fieldcount') {
+ my %fields;
+ for (my $i = 1; $i <= $param; $i++) {
+ $fields{"X-Field-$i"} = "Testing field $i";
+ }
+ print "# Testing LimitRequestFields; should $goodbad\n";
+ $resp = GET('/apache/limits/', %fields, 'X-Subtest' => $testnum);
+ ok t_cmp($resp->code,
+ $expected_rc,
+ "Test #$testnum");
+ if ($resp->code != $expected_rc) {
+ print_response($resp);
+ }
+ $testnum++;
+ }
+ elsif ($cond eq 'bodysize') {
+ #
+ # Make sure the last situation is keepalives off..
+ #
+ foreach my $chunked (qw(1 0)) {
+ print "# Testing LimitRequestBody; should $goodbad\n";
+ set_chunking($chunked);
+ #
+ # Note that this tests different things depending upon
+ # the chunking state. The content-body will not even
+ # be counted if the Content-Length of an unchunked
+ # request exceeds the server's limit; it'll just be
+ # drained and discarded.
+ #
+ if ($chunked) {
+ if ($no_chunking) {
+ my $msg = 'Chunked upload not tested; '
+ . 'not supported by this version of LWP';
+ print "# $msg\n";
+ skip $msg, 1;
+ }
+ else {
+ my ($req, $resp, $url);
+ $url = Apache::TestRequest::resolve_url('/apache/limits/');
+ $req = HTTP::Request->new(GET => $url);
+ $req->content_type('text/plain');
+ $req->header('X-Subtest' => $testnum);
+ $req->content(chunk_it($param));
+ $resp = Apache::TestRequest::user_agent->request($req);
+
+ # limit errors with chunked request bodies get
+ # 400 with 1.3, not 413 - see special chunked
+ # request handling in ap_get_client_block in 1.3
+
+ local $expected_rc = 400 if $goodbad eq 'fail' &&
+ have_apache(1);
+
+ ok t_cmp($resp->code,
+ $expected_rc,
+ "Test #$testnum");
+ if ($resp->code != $expected_rc) {
+ print_response($resp);
+ }
+ }
+ }
+ else {
+ $resp = GET('/apache/limits/', content_type => 'text/plain',
+ content => $param, 'X-Subtest' => $testnum);
+ ok t_cmp($resp->code,
+ $expected_rc,
+ "Test #$testnum");
+ if ($resp->code != $expected_rc) {
+ print_response($resp);
+ }
+ }
+ $testnum++;
+ }
+ }
+ elsif ($cond eq 'merged_fieldsize') {
+ print "# Testing LimitRequestFieldSize; should $goodbad\n";
+ $resp = GET('/apache/limits/', 'X-Subtest' => $testnum,
+ 'X-overflow-field' => $param,
+ 'X-overflow-field' => $param);
+ ok t_cmp($resp->code,
+ $expected_rc,
+ "Test #$testnum");
+ if ($resp->code != $expected_rc) {
+ print_response($resp);
+ }
+ $testnum++;
+ }
+ elsif ($cond eq 'fieldsize') {
+ print "# Testing LimitRequestFieldSize; should $goodbad\n";
+ $resp = GET('/apache/limits/', 'X-Subtest' => $testnum,
+ 'X-overflow-field' => $param);
+ ok t_cmp($resp->code,
+ $expected_rc,
+ "Test #$testnum");
+ if ($resp->code != $expected_rc) {
+ print_response($resp);
+ }
+ $testnum++;
+ }
+ elsif ($cond eq 'requestline') {
+ print "# Testing LimitRequestLine; should $goodbad\n";
+ $resp = GET($param, 'X-Subtest' => $testnum);
+ ok t_cmp($resp->code,
+ $expected_rc,
+ "Test #$testnum");
+ if ($resp->code != $expected_rc) {
+ print_response($resp);
+ }
+ $testnum++;
+ }
+ }
+}
+
+sub chunk_it {
+ my $str = shift;
+ my $delay = shift;
+
+ $delay = 1 unless defined $delay;
+ return sub {
+ select(undef, undef, undef, $delay) if $delay;
+ my $l = length($str);
+ return substr($str, 0, ($l > 102400 ? 102400 : $l), "");
+ }
+}
+
+sub set_chunking {
+ my ($setting) = @_;
+ $setting = $setting ? 1 : 0;
+ print "# Chunked transfer-encoding ",
+ ($setting ? "enabled" : "disabled"), "\n";
+ Apache::TestRequest::user_agent(keep_alive => ($setting ? 1 : 0));
+}
+
+sub print_response {
+ my ($resp) = @_;
+ my $str = $resp->as_string;
+ $str =~ s:\n:\n# :gs;
+ print "# Server response:\n# $str\n";
+}