diff options
Diffstat (limited to 'debian/perl-framework/t/apache')
| -rw-r--r-- | debian/perl-framework/t/apache/expr.t | 2 | ||||
| -rw-r--r-- | debian/perl-framework/t/apache/expr_string.t | 9 | ||||
| -rw-r--r-- | debian/perl-framework/t/apache/hostcheck.t | 5 | ||||
| -rw-r--r-- | debian/perl-framework/t/apache/leaks.t | 76 | ||||
| -rw-r--r-- | debian/perl-framework/t/apache/limits.t | 6 | ||||
| -rw-r--r-- | debian/perl-framework/t/apache/mergeslashes.t | 117 | ||||
| -rw-r--r-- | debian/perl-framework/t/apache/pr64339.t | 46 | ||||
| -rw-r--r-- | debian/perl-framework/t/apache/teclchunk.t | 57 |
8 files changed, 269 insertions, 49 deletions
diff --git a/debian/perl-framework/t/apache/expr.t b/debian/perl-framework/t/apache/expr.t index 58c4a57..7d62bc0 100644 --- a/debian/perl-framework/t/apache/expr.t +++ b/debian/perl-framework/t/apache/expr.t @@ -268,6 +268,8 @@ if (have_min_apache_version("2.5")) { [ "'email:<redacted2>' -in split s/$SAN_split/\$1/, $SAN_list_one" => 0 ], [ "'IP Address:%{REMOTE_ADDR}' -in split/, /, join $SAN_list_one" => 1 ], + [ "replace(%{REQUEST_METHOD}, 'E', 'O') == 'GOT'" => 1], + [ "replace(%{REQUEST_METHOD}, 'E', 'O') == 'GET'" => 0], )); } diff --git a/debian/perl-framework/t/apache/expr_string.t b/debian/perl-framework/t/apache/expr_string.t index a9115ee..4682d4a 100644 --- a/debian/perl-framework/t/apache/expr_string.t +++ b/debian/perl-framework/t/apache/expr_string.t @@ -3,10 +3,12 @@ use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; -use Apache::TestUtil qw(t_write_file t_start_error_log_watch t_finish_error_log_watch); +use Apache::TestUtil qw(t_write_file t_start_error_log_watch t_finish_error_log_watch t_cmp); use File::Spec; +use Time::HiRes qw(usleep); + # test ap_expr Apache::TestRequest::user_agent(keep_alive => 1); @@ -62,6 +64,8 @@ foreach my $t (@test_cases) { 'SomeHeader' => 'SomeValue', 'User-Agent' => 'SomeAgent', 'Referer' => 'SomeReferer'); + ### Sleep here, attempt to avoid intermittent failures. + usleep(250000); my @loglines = t_finish_error_log_watch(); my @evalerrors = grep {/(?:internal evaluation error|flex scanner jammed)/i @@ -97,8 +101,7 @@ foreach my $t (@test_cases) { [ ]\(log_transaction) # trailing hook info (LogLevel debug and higher) }x ) { my $result = $1; - print "Got '$result', expected '$expect'\n"; - ok($result eq $expect); + ok t_cmp($result, $expect, "log message @msg didn't match"); } else { print "Can't extract expr result from log message:\n@msg\n"; diff --git a/debian/perl-framework/t/apache/hostcheck.t b/debian/perl-framework/t/apache/hostcheck.t index a295af7..62bb38d 100644 --- a/debian/perl-framework/t/apache/hostcheck.t +++ b/debian/perl-framework/t/apache/hostcheck.t @@ -21,7 +21,7 @@ my @test_cases = ( [ "GET / HTTP/1.1\r\nHost: nvh-strict\r\n\r\n" => 200, 200, "NVH matches"], [ "GET / HTTP/1.1\r\nHost: nvh-strict:1\r\n\r\n" => 200, 200, "NVH matches port ignored"], ); -plan tests => scalar(@test_cases) * 2, need_min_apache_version('2.5.1'); +plan tests => scalar(@test_cases) * 2, need_min_apache_version('2.4.49'); foreach my $vhosts ((["default" => 1], ["core" => 2])) { @@ -41,11 +41,10 @@ foreach my $vhosts ((["default" => 1], ["core" => 2])) { next; } + print "# SENDING to " . peer($sock) . "\n# $req\n"; $sock->print($req); $sock->shutdown(1); - sleep(0.1); $req = escape($req); - print "# SENDING to " . peer($sock) . "\n# $req\n"; my $response_data = ""; my $buf; diff --git a/debian/perl-framework/t/apache/leaks.t b/debian/perl-framework/t/apache/leaks.t index 99ce600..bb7b329 100644 --- a/debian/perl-framework/t/apache/leaks.t +++ b/debian/perl-framework/t/apache/leaks.t @@ -9,61 +9,55 @@ my $url = "/memory_track"; my $init_iters = 2000; my $iters = 500; +my $active = GET_RC($url) == 200; + my $num_tests = $init_iters + $iters * 2; -plan tests => $num_tests; +plan tests => $num_tests, + need { "mod_memory_track not activated" => $active }; ### this doesn't seem sufficient to force all requests over a single ### persistent connection any more, is there a better trick? Apache::TestRequest::user_agent(keep_alive => 1); Apache::TestRequest::scheme('http'); -my $r = GET $url; +my $cid = -1; +my $mem; -if ($r->code != 200) { - # these tests will be skipped for async MPMs or with an APR not - # built with --enable-pool-debug. - skip "mod_memory_track not activated" foreach (1..$num_tests); +# initial iterations should get workers to steady-state memory use. +foreach (1..$init_iters) { + ok t_cmp(GET_RC($url), 200, "200 response"); } -else { - my $cid = -1; - my $mem; - - # initial iterations should get workers to steady-state memory use. - foreach (1..$init_iters) { - ok t_cmp(GET_RC($url), 200, "200 response"); - } - # now test whether c->pool memory is increasing for further - # requests on a given conn_rec (matched by id)... could track them - # all with a bit more effort. - foreach (1..$iters) { - $r = GET $url; +# now test whether c->pool memory is increasing for further +# requests on a given conn_rec (matched by id)... could track them +# all with a bit more effort. +foreach (1..$iters) { + my $r = GET $url; - print "# iter $_\n"; - - ok t_cmp($r->code, 200, "got response"); + print "# iter $_\n"; + + ok t_cmp($r->code, 200, "got response"); - my $content = $r->content; - chomp $content; - my ($key, $id, $bytes) = split ',', $content; + my $content = $r->content; + chomp $content; + my ($key, $id, $bytes) = split ',', $content; - print "# $key, $id, $bytes\n"; + print "# $key, $id, $bytes\n"; - if ($cid == -1) { - $cid = $id; - $mem = $bytes; - ok 1; - } - elsif ($cid != $id) { - skip "using wrong connection"; - } - elsif ($bytes > $mem) { - print "# error: pool memory increased from $mem to $bytes!\n"; - ok 0; - } - else { - ok 1; - } + if ($cid == -1) { + $cid = $id; + $mem = $bytes; + ok 1; + } + elsif ($cid != $id) { + skip "using wrong connection"; + } + elsif ($bytes > $mem) { + print "# error: pool memory increased from $mem to $bytes!\n"; + ok 0; + } + else { + ok 1; } } diff --git a/debian/perl-framework/t/apache/limits.t b/debian/perl-framework/t/apache/limits.t index 124f731..a475f82 100644 --- a/debian/perl-framework/t/apache/limits.t +++ b/debian/perl-framework/t/apache/limits.t @@ -12,7 +12,7 @@ use Apache::TestUtil; # # These values are chosen to exceed the limits in extra.conf, namely: # -# LimitRequestLine 128 +# LimitRequestLine @limitrequestline@ # LimitRequestFieldSize 1024 # LimitRequestFields 32 # <Directory @SERVERROOT@/htdocs/apache/limits> @@ -20,10 +20,12 @@ use Apache::TestUtil; # </Directory> # +my $limitrequestlinex2 = Apache::Test::config()->{vars}->{limitrequestlinex2}; + my @conditions = qw(requestline fieldsize fieldcount bodysize merged_fieldsize); my %params = ('requestline-succeed' => "/apache/limits/", - 'requestline-fail' => ("/apache/limits/" . ('a' x 256)), + 'requestline-fail' => ("/apache/limits/" . ('a' x $limitrequestlinex2)), 'fieldsize-succeed' => 'short value', 'fieldsize-fail' => ('a' x 2048), 'fieldcount-succeed' => 1, diff --git a/debian/perl-framework/t/apache/mergeslashes.t b/debian/perl-framework/t/apache/mergeslashes.t new file mode 100644 index 0000000..850fc93 --- /dev/null +++ b/debian/perl-framework/t/apache/mergeslashes.t @@ -0,0 +1,117 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestRequest; +use Apache::TestUtil; +use MIME::Base64; +use Data::Dumper; +use HTTP::Response; +use Socket; + +# undef: HTTPD should drop connection without error message + +my @test_cases = ( + # request, status code global, status code 'mergeslashes off' VH, msg + [ "GET /authz_core/a/b/c/index.html HTTP/1.1\r\nHost: merge-default\r\nConnection: close\r\n\r\n" => 403, "exact match"], + [ "GET //authz_core/a/b/c/index.html HTTP/1.1\r\nHost: merge-default\r\nConnection: close\r\n\r\n" => 403, "merged even at front"], + [ "GET ///authz_core/a/b/c/index.html HTTP/1.1\r\nHost: merge-default\r\nConnection: close\r\n\r\n" => 403, "merged even at front"], + [ "GET /authz_core/a/b/c//index.html HTTP/1.1\r\nHost: merge-default\r\nConnection: close\r\n\r\n" => 403, "c// should be merged"], + [ "GET /authz_core/a//b/c/index.html HTTP/1.1\r\nHost: merge-default\r\nConnection: close\r\n\r\n" => 403, "a// should be merged"], + [ "GET /authz_core/a//b/c/index.html HTTP/1.1\r\nHost: merge-disabled\r\nConnection: close\r\n\r\n" => 403, "a// matches locationmatch"], + [ "GET /authz_core/a/b/c//index.html HTTP/1.1\r\nHost: merge-disabled\r\nConnection: close\r\n\r\n" => 200, "c// doesn't match locationmatch"], + [ "GET /authz_core/a/b/d/index.html HTTP/1.1\r\nHost: merge-disabled\r\nConnection: close\r\n\r\n" => 403, "baseline failed", need_min_apache_version('2.4.47')], + [ "GET /authz_core/a/b//d/index.html HTTP/1.1\r\nHost: merge-disabled\r\nConnection: close\r\n\r\n" => 403, "b//d not merged for Location with OFF",need_min_apache_version('2.4.47')], +); + +plan tests => scalar(@test_cases), need_min_apache_version('2.4.39'); + + + foreach my $t (@test_cases) { + my $req = $t->[0]; + my $expect = $t->[1]; + my $desc = $t->[2]; + my $cond = $t->[3]; + my $decoded; + + if (defined($cond) && !$cond) { + skip("n/a"); + } + + my $sock = Apache::TestRequest::vhost_socket("core"); + if (!$sock) { + print "# failed to connect\n"; + ok(0); + next; + } + + $sock->print($req); + sleep(0.1); + $req = escape($req); + print "# SENDING to " . peer($sock) . "\n# $req\n"; + + my $response_data = ""; + my $buf; + while ($sock->read($buf, 10000) > 0) { + $response_data .= $buf; + } + my $response = HTTP::Response->parse($response_data); + if ($decoded) { + $response_data =~ s/<title>.*/.../s; + my $out = escape($response_data); + $out =~ s{\\n}{\\n\n# }g; + print "# RESPONSE:\n# $out\n"; + } + if (! defined $response) { + die "HTTP::Response->parse failed"; + } + my $rc = $response->code; + if (! defined $rc) { + if (! defined $expect) { + print "# expecting dropped connection and HTTPD dropped connection\n"; + ok(1); + } + else { + print "# expecting $expect, but HTTPD dropped the connection\n"; + ok(0); + } + } + elsif ($expect > 100) { + print "# expected $expect, got " . $response->code . " for $desc\n"; + ok ($response->code, $expect, $desc ); + } + elsif ($expect == 90) { + print "# expecting headerless HTTP/0.9 body, got response\n"; + ok (1); + } + elsif ($expect) { + print "# expecting success, got ", $rc, ": $desc\n"; + ok ($rc >= 200 && $rc < 400); + } + else { + print "# expecting error, got ", $rc, ": $desc\n"; + ok ($rc >= 400); + } + } + +sub escape +{ + my $in = shift; + $in =~ s{\\}{\\\\}g; + $in =~ s{\r}{\\r}g; + $in =~ s{\n}{\\n}g; + $in =~ s{\t}{\\t}g; + $in =~ s{([\x00-\x1f])}{sprintf("\\x%02x", ord($1))}ge; + return $in; +} + +sub peer +{ + my $sock = shift; + my $hersockaddr = getpeername($sock); + return "<disconnected>" if !$hersockaddr; + my ($port, $iaddr) = sockaddr_in($hersockaddr); + my $herhostname = gethostbyaddr($iaddr, AF_INET); + my $herstraddr = inet_ntoa($iaddr); + return "$herstraddr:$port"; +} diff --git a/debian/perl-framework/t/apache/pr64339.t b/debian/perl-framework/t/apache/pr64339.t new file mode 100644 index 0000000..00097e6 --- /dev/null +++ b/debian/perl-framework/t/apache/pr64339.t @@ -0,0 +1,46 @@ + +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestUtil; +use Apache::TestRequest; + +my @testcases = ( + # Backend sends Content-Type: application/xml; charset=utf-8 + ['/doc.xml', "application/xml; charset=utf-8", "fóó\n" ], + + # Backend sends Content-Type: application/foo+xml; charset=utf-8 + ['/doc.fooxml', "application/foo+xml; charset=utf-8", "fóó\n" ], + + # Backend sends Content-Type: application/notreallyxml (no charset) + # This should NOT be transformed or have a charset added. + ['/doc.notxml', "application/notreallyxml", "f\xf3\xf3\n" ], + + # Sent with charset=ISO-8859-1 - should be transformed to utf-8 + ['/doc.isohtml', "text/html;charset=utf-8", "<html><body><p>fóó\n</p></body></html>" ], +); + +# mod_xml2enc on trunk behaves quite differently to the 2.4.x version +# after r1785780, and does NOT transform the response body. Unclear if +# this is a regression, so restricting this test to 2.4.x (for now). + +if (have_min_apache_version('2.5.0')) { + print "1..0 # skip: Test only valid for 2.4.x"; + exit 0; +} + +if (not have_min_apache_version('2.4.59')) { + print "1..0 # skip: Test not valid before 2.4.59"; + exit 0; +} + +plan tests => (3*scalar @testcases), need [qw(xml2enc alias proxy_html proxy)]; + +foreach my $t (@testcases) { + my $r = GET("/modules/xml2enc/front".$t->[0]); + + ok t_cmp($r->code, 200, "fetching ".$t->[0]); + ok t_cmp($r->header('Content-Type'), $t->[1], "content-type header test for ".$t->[0]); + ok t_cmp($r->content, $t->[2], "content test for ".$t->[0]); +} diff --git a/debian/perl-framework/t/apache/teclchunk.t b/debian/perl-framework/t/apache/teclchunk.t new file mode 100644 index 0000000..b804368 --- /dev/null +++ b/debian/perl-framework/t/apache/teclchunk.t @@ -0,0 +1,57 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestUtil; +use Apache::TestCommon (); +use Apache::TestRequest (); + +my $module = 'default'; + +if (!have_min_apache_version('2.5.0')) { + print "1..0 # skip: Not supported yet"; + exit 0; +} + +plan tests => 4, ['echo_post_chunk']; + +my $sock = Apache::TestRequest::vhost_socket($module); +ok $sock; + +Apache::TestRequest::socket_trace($sock); +$sock->print("POST /echo_post_chunk HTTP/1.1\r\n"); +$sock->print("Host: localhost\r\n"); +$sock->print("Content-Length: 77\r\n"); +$sock->print("Transfer-Encoding: chunked\r\n"); +$sock->print("\r\n"); +$sock->print("0\r\n"); +$sock->print("X-Chunk-Trailer: $$\r\n"); +$sock->print("\r\n"); +$sock->print("GET /i_do_not_exist_in_your_wildest_imagination HTTP/1.1\r\n"); +$sock->print("Host: localhost\r\n"); + +# Read the status line +chomp(my $response = Apache::TestRequest::getline($sock) || ''); +$response =~ s/\s$//; +ok t_cmp($response, "HTTP/1.1 200 OK", "response codes"); + +# Read the rest +do { + chomp($response = Apache::TestRequest::getline($sock)); + $response =~ s/\s$//; +} +while ($response ne ""); + +# Do the next request... that MUST fail. +$sock->print("\r\n"); +$sock->print("\r\n"); + +# read the trailer (pid) +$response = Apache::TestRequest::getline($sock); +chomp($response) if (defined($response)); +ok t_cmp($response, "$$", "trailer (pid)"); + +# Make sure we have not received a 404. +chomp($response = Apache::TestRequest::getline($sock) || 'NO'); +$response =~ s/\s$//; +ok t_cmp($response, "NO", "no response"); |