summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/apache
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/apache
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_deb11u2
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/perl-framework/t/apache')
-rw-r--r--debian/perl-framework/t/apache/404.t16
-rw-r--r--debian/perl-framework/t/apache/acceptpathinfo.t86
-rw-r--r--debian/perl-framework/t/apache/byterange.t57
-rw-r--r--debian/perl-framework/t/apache/byterange2.t15
-rw-r--r--debian/perl-framework/t/apache/byterange3.t73
-rw-r--r--debian/perl-framework/t/apache/byterange4.t52
-rw-r--r--debian/perl-framework/t/apache/byterange5.t104
-rw-r--r--debian/perl-framework/t/apache/byterange6.t162
-rw-r--r--debian/perl-framework/t/apache/byterange7.t119
-rw-r--r--debian/perl-framework/t/apache/cfg_getline.t46
-rw-r--r--debian/perl-framework/t/apache/chunkinput.t93
-rw-r--r--debian/perl-framework/t/apache/contentlength.t83
-rw-r--r--debian/perl-framework/t/apache/errordoc.t108
-rw-r--r--debian/perl-framework/t/apache/etags.t170
-rw-r--r--debian/perl-framework/t/apache/expr.t327
-rw-r--r--debian/perl-framework/t/apache/expr_string.t123
-rw-r--r--debian/perl-framework/t/apache/getfile.t24
-rw-r--r--debian/perl-framework/t/apache/headers.t96
-rw-r--r--debian/perl-framework/t/apache/hostcheck.t113
-rw-r--r--debian/perl-framework/t/apache/http_strict.t243
-rw-r--r--debian/perl-framework/t/apache/if_sections.t76
-rw-r--r--debian/perl-framework/t/apache/iffile.t17
-rw-r--r--debian/perl-framework/t/apache/leaks.t63
-rw-r--r--debian/perl-framework/t/apache/limits.t217
-rw-r--r--debian/perl-framework/t/apache/loglevel.t43
-rw-r--r--debian/perl-framework/t/apache/maxranges.t70
-rw-r--r--debian/perl-framework/t/apache/mergeslashes.t117
-rw-r--r--debian/perl-framework/t/apache/mmn.t42
-rw-r--r--debian/perl-framework/t/apache/options.t17
-rw-r--r--debian/perl-framework/t/apache/passbrigade.t7
-rw-r--r--debian/perl-framework/t/apache/post.t12
-rw-r--r--debian/perl-framework/t/apache/pr17629.t51
-rw-r--r--debian/perl-framework/t/apache/pr18757.t58
-rw-r--r--debian/perl-framework/t/apache/pr35292.t33
-rw-r--r--debian/perl-framework/t/apache/pr35330.t16
-rw-r--r--debian/perl-framework/t/apache/pr37166.t29
-rw-r--r--debian/perl-framework/t/apache/pr43939.t47
-rw-r--r--debian/perl-framework/t/apache/pr49328.t25
-rw-r--r--debian/perl-framework/t/apache/rwrite.t6
-rw-r--r--debian/perl-framework/t/apache/server_name_port.t135
-rw-r--r--debian/perl-framework/t/apache/teclchunk.t57
41 files changed, 3248 insertions, 0 deletions
diff --git a/debian/perl-framework/t/apache/404.t b/debian/perl-framework/t/apache/404.t
new file mode 100644
index 0000000..83e9c06
--- /dev/null
+++ b/debian/perl-framework/t/apache/404.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+
+plan tests => 2;
+
+my $four_oh_four = GET_STR "/404/not/found/test";
+
+print "# GET_STR Response:\n# ",
+ join("\n# ", split(/\n/, $four_oh_four)), "\n";
+
+ok (($four_oh_four =~ /HTTP\/1\.[01] 404 Not Found/)
+ || ($four_oh_four =~ /RC:\s+404.*Message:\s+Not Found/s));
+ok ($four_oh_four =~ /Content-Type: text\/html/);
diff --git a/debian/perl-framework/t/apache/acceptpathinfo.t b/debian/perl-framework/t/apache/acceptpathinfo.t
new file mode 100644
index 0000000..b42093c
--- /dev/null
+++ b/debian/perl-framework/t/apache/acceptpathinfo.t
@@ -0,0 +1,86 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+my $havecgi = have_cgi();
+
+my $pathinfo = "/foo/bar";
+
+##
+## mode path, filerc, filebody, cgirc, cgibody
+##
+my %tests = (
+ default => [ "", "404","Not Found", "200","_${pathinfo}_" ],
+ on => [ "/on", "200","_${pathinfo}_","200","_${pathinfo}_" ],
+ off => [ "/off","404","Not Found", "404","Not Found" ]
+ );
+
+
+my @files = ("", "/index.shtml");
+push @files, "/test.sh" if ($havecgi);
+
+my $numtests = ((scalar keys %tests) * (scalar @files) * 4);
+plan tests => $numtests, need need_apache(2), need_module('include'), need_lwp;
+
+my $loc = "/apache/acceptpathinfo";
+
+foreach my $mode (keys %tests) {
+ foreach my $file (@files) {
+
+ foreach my $pinf ("","$pathinfo") {
+
+ my ($expectedrc, $expectedbody);
+
+ if ($pinf eq "") {
+ $expectedrc = "200";
+ $expectedbody = "_\\(none\\)_";
+ }
+ else {
+ if ($file eq "") {
+ $expectedrc = "404";
+ $expectedbody = "Not Found";
+ }
+ elsif ($file eq "/index.shtml") {
+ $expectedrc = $tests{$mode}[1];
+ $expectedbody = $tests{$mode}[2];
+ }
+ else {
+ $expectedrc = $tests{$mode}[3];
+ $expectedbody = $tests{$mode}[4];
+ }
+ }
+
+
+ my $req = $loc.$tests{$mode}[0].$file.$pinf;
+
+ my $resp = GET $req;
+
+ ok t_cmp($resp->code,
+ $expectedrc,
+ "AcceptPathInfo $mode return code for $req"
+ );
+
+ my $actual = super_chomp($resp->content);
+ ok t_cmp($actual,
+ qr/$expectedbody/,
+ "AcceptPathInfo $mode body for $req"
+ );
+ }
+ }
+}
+
+sub super_chomp {
+ my ($body) = shift;
+
+ ## super chomp - all leading and trailing \n (and \r for win32)
+ $body =~ s/^[\n\r]*//;
+ $body =~ s/[\n\r]*$//;
+ ## and all the rest change to spaces
+ $body =~ s/\n/ /g;
+ $body =~ s/\r//g; #rip out all remaining \r's
+
+ $body;
+}
diff --git a/debian/perl-framework/t/apache/byterange.t b/debian/perl-framework/t/apache/byterange.t
new file mode 100644
index 0000000..e439d1d
--- /dev/null
+++ b/debian/perl-framework/t/apache/byterange.t
@@ -0,0 +1,57 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest ();
+use Apache::TestCommon ();
+
+Apache::TestCommon::run_files_test(\&verify, 1);
+
+sub verify {
+ my($ua, $url, $file) = @_;
+ my $debug = $Apache::TestRequest::DebugLWP;
+
+ $url = Apache::TestRequest::resolve_url($url);
+ my $req = HTTP::Request->new(GET => $url);
+
+ my $total = 0;
+ my $chunk_size = 8192;
+
+ my $wanted = -s $file;
+
+ while ($total < $wanted) {
+ my $end = $total + $chunk_size;
+ if ($end > $wanted) {
+ $end = $wanted;
+ }
+
+ my $range = "bytes=$total-$end";
+ $req->header(Range => $range);
+
+ print $req->as_string if $debug;
+
+ my $res = $ua->request($req);
+ my $content_range = $res->header('Content-Range') || 'NONE';
+
+ $res->content("") if $debug and $debug == 1;
+ print $res->as_string if $debug;
+
+ if ($content_range =~ m:^bytes\s+(\d+)-(\d+)/(\d+):) {
+ my($start, $end, $total_bytes) = ($1, $2, $3);
+ $total += ($end - $start) + 1;
+ }
+ elsif ($total == 0 && $end == $wanted &&
+ $content_range eq 'NONE' && $res->code == 200) {
+ $total += $wanted;
+ }
+ else {
+ print "Range: $range\n";
+ print "Content-Range: $content_range\n";
+ last;
+ }
+ }
+
+ print "downloaded $total bytes, file is $wanted bytes\n";
+
+ ok $total == $wanted;
+}
diff --git a/debian/perl-framework/t/apache/byterange2.t b/debian/perl-framework/t/apache/byterange2.t
new file mode 100644
index 0000000..f0dcc1e
--- /dev/null
+++ b/debian/perl-framework/t/apache/byterange2.t
@@ -0,0 +1,15 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+plan tests => 1, need need_min_apache_version('2.0.51'), need_cgi;
+
+my $resp;
+
+$resp = GET_BODY "/modules/cgi/ranged.pl",
+ Range => 'bytes=5-10/10';
+
+ok t_cmp($resp, "hello\n", "return correct content");
diff --git a/debian/perl-framework/t/apache/byterange3.t b/debian/perl-framework/t/apache/byterange3.t
new file mode 100644
index 0000000..56932f1
--- /dev/null
+++ b/debian/perl-framework/t/apache/byterange3.t
@@ -0,0 +1,73 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest ();
+use Apache::TestCommon ();
+
+# test merging of byte ranges
+
+if (Apache::Test::need_min_apache_version("2.3.15")) {
+ Apache::TestCommon::run_files_test(\&verify, 1);
+}
+else {
+ plan tests => 0;
+}
+
+sub verify {
+ my($ua, $url, $file) = @_;
+ my $debug = $Apache::TestRequest::DebugLWP;
+
+ $url = Apache::TestRequest::resolve_url($url);
+ my $req = HTTP::Request->new(GET => $url);
+
+ my $total = 0;
+ my $chunk_size = 8192;
+
+ my $wanted = -s $file;
+
+ while ($total < $wanted) {
+ my $end = $total + $chunk_size;
+ if ($end > $wanted) {
+ $end = $wanted;
+ }
+
+ my $t1 = $total+1;
+ my $t10 = $total+5;
+ my $e1 = $end-1;
+ my $e20 = $end-10;
+ #my $range = "bytes=$total-$end";
+ my $range = "bytes=$t10-$end,$total-$e1,$t10-$e20,$total-$e1";
+ if ($end - $total < 15) {
+ # make sure to not send invalid ranges with start > end
+ $range = "bytes=$total-$end";
+ }
+ $req->header(Range => $range);
+
+ print $req->as_string if $debug;
+
+ my $res = $ua->request($req);
+ my $content_range = $res->header('Content-Range') || 'NONE';
+
+ $res->content("") if $debug and $debug == 1;
+ print $res->as_string if $debug;
+
+ if ($content_range =~ m:^bytes\s+(\d+)-(\d+)/(\d+):) {
+ my($start, $end, $total_bytes) = ($1, $2, $3);
+ $total += ($end - $start) + 1;
+ }
+ elsif ($total == 0 && $end == $wanted &&
+ $content_range eq 'NONE' && $res->code == 200) {
+ $total += $wanted;
+ }
+ else {
+ print "Range: $range\n";
+ print "Content-Range: $content_range\n";
+ last;
+ }
+ }
+
+ print "downloaded $total bytes, file is $wanted bytes\n";
+
+ ok $total == $wanted;
+}
diff --git a/debian/perl-framework/t/apache/byterange4.t b/debian/perl-framework/t/apache/byterange4.t
new file mode 100644
index 0000000..73572d7
--- /dev/null
+++ b/debian/perl-framework/t/apache/byterange4.t
@@ -0,0 +1,52 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_write_file);
+
+# test byteranges if range boundaries are near bucket boundaries
+
+my $url = "/apache/chunked/byteranges.txt";
+my $file = Apache::Test::vars('serverroot') . "/htdocs$url";
+
+my $content = "";
+$content .= sprintf("%04d", $_) for (1 .. 2000);
+my $clen = length($content);
+
+# make mod_bucketeer create buckets of size 200 from our 4000 bytes
+my $blen = 200;
+my $B = chr(0x02);
+my @buckets = ($content =~ /(.{1,$blen})/g);
+my $file_content = join($B, @buckets);
+t_write_file($file, $file_content);
+
+
+my @range_boundaries = (
+ 0, 1, 2,
+ $blen-2, $blen-1, $blen, $blen+1,
+ 3*$blen-2, 3*$blen-1, 3*$blen, 3*$blen+1,
+ $clen-$blen-2, $clen-$blen-1, $clen-$blen, $clen-$blen+1,
+ $clen-2, $clen-1,
+);
+my @test_cases;
+for my $start (@range_boundaries) {
+ for my $end (@range_boundaries) {
+ push @test_cases, [$start, $end] unless ($end < $start);
+ }
+}
+
+plan tests => scalar(@test_cases), need need_lwp,
+ need_module('mod_bucketeer');
+
+foreach my $test (@test_cases) {
+ my ($start, $end) = @$test;
+ my $r = "$start-$end";
+ print "range: $r\n";
+ my $result = GET $url, "Range" => "bytes=$r";
+ my $expect = substr($content, $start, $end - $start + 1);
+ my $got = $result->content;
+ print("rc " . $result->code . "\n");
+ print("expect: '$expect'\ngot: '$got'\n");
+ ok ($got eq $expect);
+}
diff --git a/debian/perl-framework/t/apache/byterange5.t b/debian/perl-framework/t/apache/byterange5.t
new file mode 100644
index 0000000..d069946
--- /dev/null
+++ b/debian/perl-framework/t/apache/byterange5.t
@@ -0,0 +1,104 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_write_file);
+
+# test multi-byterange-requests while allowing re-ordering
+
+my $url = "/apache/chunked/byteranges.txt";
+my $file = Apache::Test::vars('serverroot') . "/htdocs$url";
+
+my $content = "";
+$content .= sprintf("%04d", $_) for (1 .. 2000);
+t_write_file($file, $content);
+my $clen = length($content);
+
+
+my @test_cases = (
+ "0-1,1000-1001",
+ "1000-1100,100-200",
+ "1000-1100,100-200,2000-2200",
+ "1000-1100,100-200,2000-",
+ "3000-,100-200,2000-2200",
+);
+plan tests => scalar(@test_cases), need need_lwp;
+
+foreach my $test (@test_cases) {
+ my $result = GET $url, "Range" => "bytes=$test";
+ my $boundary;
+ my $ctype = $result->header("Content-Type");
+ if ($ctype =~ m{multipart/byteranges; boundary=(.*)}) {
+ $boundary = $1;
+ }
+ else {
+ print "Wrong Content-Type: $ctype\n";
+ ok(0);
+ next;
+ }
+
+ my @want = split(",", $test);
+ foreach my $w (@want) {
+ $w =~ /(\d*)-(\d*)/ or die;
+ if (defined $1 eq "") {
+ $w = [ $clen - $2, $clen - 1 ];
+ }
+ elsif ($2 eq "") {
+ $w = [ $1, $clen - 1 ];
+ }
+ else {
+ $w = [ $1, $2 ];
+ }
+ }
+
+ my @got;
+ my $rcontent = $result->content;
+ my $error;
+ while ($rcontent =~ s{^[\n\s]*--$boundary\s*?\n(.+?)\r\n\r\n}{}s ) {
+ my $headers = $1;
+ my ($from, $to);
+ if ($headers =~ m{^Content-range: bytes (\d+)-(\d+)/\d*$}mi ) {
+ $from = $1;
+ $to = $2;
+ }
+ else {
+ print "Can't parse Content-range in '$headers'\n";
+ $error = 1;
+ }
+ push @got, [$from, $to];
+ my $chunk = substr($rcontent, 0, $to - $from + 1, "");
+ my $expect = substr($content, $from, $to - $from + 1);
+ if ($chunk ne $expect) {
+ print "Wrong content in range. Got: \n",
+ $headers, $content,
+ "Expected:\n$expect\n";
+ $error = 1;
+ }
+ }
+ if ($error) {
+ ok(0);
+ next;
+ }
+ if ($rcontent !~ /^[\s\n]*--${boundary}--[\s\n]*$/) {
+ print "error parsing final boundary: '$rcontent'\n";
+ ok(0);
+ next;
+ }
+ foreach my $w (@want) {
+ my $found;
+ foreach my $g (@got) {
+ $found = 1 if ($g->[0] <= $w->[0] && $g->[1] >= $w->[1]);
+ }
+ if (!$found) {
+ print "Data for '$w->[0]-$w->[1]' not found in response\n";
+ $error = 1;
+ }
+ }
+ if ($error) {
+ ok(0);
+ next;
+ }
+
+ ok (1);
+}
diff --git a/debian/perl-framework/t/apache/byterange6.t b/debian/perl-framework/t/apache/byterange6.t
new file mode 100644
index 0000000..5fae418
--- /dev/null
+++ b/debian/perl-framework/t/apache/byterange6.t
@@ -0,0 +1,162 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_write_file t_debug);
+
+# test multi-byterange-requests with overlaps (merges)
+
+my $url = "/apache/chunked/byteranges.txt";
+my $file = Apache::Test::vars('serverroot') . "/htdocs$url";
+
+my $content = "";
+$content .= sprintf("%04d", $_) for (1 .. 2000);
+t_write_file($file, $content);
+my $clen = length($content);
+
+
+my @test_cases = (
+ { h => "0-100,70-100,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-90,70-100,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-70,70-100,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "1-100,70-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "1-90,70-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "1-90,70-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "0-100,70-100,1000-1001,5-6", actlike => "0-100,1000-1001,5-6"},
+ { h => "0-90,70-100,1000-1001,5-6", actlike => "0-100,1000-1001,5-6"},
+ { h => "0-70,70-100,1000-1001,5-6", actlike => "0-100,1000-1001,5-6"},
+ { h => "1-100,70-100,1000-1001,5-6", actlike => "1-100,1000-1001,5-6"},
+
+ { h => "1-90,70-100,1000-1001,5-6", actlike => "1-100,1000-1001,5-6"},
+ { h => "1-90,70-100,1000-1001,5-6", actlike => "1-100,1000-1001,5-6"},
+ { h => "1-70,70-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "1-70,71-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "1-70,69-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "1-70,0-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "0-70,72-100,1000-1001", actlike => "0-70,72-100,1000-1001"},
+ { h => "1-70,0-100,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "1-70,1-100,1000-1001", actlike => "1-100,1000-1001"},
+ { h => "1-70,2-100,1000-1001", actlike => "1-100,1000-1001"},
+
+ { h => "0-100,0-99,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-100,0-100,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-100,0-101,1000-1001", actlike => "0-101,1000-1001"},
+ { h => "0-100,1-99,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-100,1-100,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-100,1-101,1000-1001", actlike => "0-101,1000-1001"},
+ { h => "0-100,50-99,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-100,50-100,1000-1001", actlike => "0-100,1000-1001"},
+ { h => "0-100,50-101,1000-1001", actlike => "0-101,1000-1001"},
+ { h => "1-10,1-9,99-99", actlike => "1-10,99-99"},
+
+ { h => "1-10,1-10,99-99", actlike => "1-10,99-99"},
+ { h => "1-10,1-11,99-99", actlike => "1-11,99-99"},
+ { h => "1-10,0-9,99-99", actlike => "0-10,99-99"},
+ { h => "1-10,0-10,99-99", actlike => "0-10,99-99"},
+ { h => "1-10,0-11,99-99", actlike => "0-11,99-99"},
+ { h => "1-10,0-12,99-99", actlike => "0-12,99-99"},
+ { h => "1-10,0-13,99-99", actlike => "0-13,99-99"},
+ { h => "1-10,2-11,99-99", actlike => "1-11,99-99"},
+ { h => "1-10,2-12,99-99", actlike => "1-12,99-99"},
+ { h => "1-10,2-13,99-99", actlike => "1-13,99-99"},
+
+ { h => "1-10,1-9,99-99", actlike => "1-10,99-99"},
+ { h => "1-11,1-10,99-99", actlike => "1-11,99-99"},
+ { h => "1-9,1-10,99-99", actlike => "1-10,99-99"},
+ { h => "0-11,1-10,99-99", actlike => "0-11,99-99"},
+ { h => "1-9,1-10,99-99", actlike => "1-10,99-99"},
+ { h => "10-20,1-9,99-99", actlike => "1-20,99-99"},
+ { h => "10-20,1-10,99-99", actlike => "1-20,99-99"},
+ { h => "10-20,1-11,99-99", actlike => "1-20,99-99"},
+ { h => "10-20,1-21,99-99", actlike => "1-21,99-99"},
+
+ { h => "5-10,11-12,99-99", actlike => "5-12,99-99"},
+ { h => "5-10,1-4,99-99", actlike => "1-10,99-99"},
+ { h => "5-10,1-3,99-99", actlike => "5-10,1-3,99-99"},
+
+ { h => "0-1,-1", actlike => "0-1,-1"}, # PR 51748
+
+);
+plan tests => scalar(@test_cases), need need_lwp,
+ need_min_apache_version('2.3.15');
+
+
+foreach my $test (@test_cases) {
+ my $result = GET $url, "Range" => "bytes=" . $test->{"h"} ;
+ my $boundary;
+ my $ctype = $result->header("Content-Type");
+ if ($ctype =~ m{multipart/byteranges; boundary=(.*)}) {
+ $boundary = $1;
+ }
+ else {
+ print "Wrong Content-Type: $ctype, for ".$test->{"h"}."\n";
+ ok(0);
+ next;
+ }
+
+ my @want = split(",", $test->{"actlike"});
+ foreach my $w (@want) {
+ $w =~ /(\d*)-(\d*)/ or die;
+ if ($1 eq "") {
+ $w = [ $clen - $2, $clen - 1 ];
+ }
+ elsif ($2 eq "") {
+ $w = [ $1, $clen - 1 ];
+ }
+ else {
+ $w = [ $1, $2 ];
+ }
+ t_debug("expecting range ". $w->[0]. "-". $w->[1]);
+ }
+
+ my @got;
+ my $rcontent = $result->content;
+ my $error;
+ while ($rcontent =~ s{^[\n\s]*--$boundary\s*?\n(.+?)\r\n\r\n}{}s ) {
+ my $headers = $1;
+ my ($from, $to);
+ if ($headers =~ m{^Content-range: bytes (\d+)-(\d+)/\d*$}mi ) {
+ $from = $1;
+ $to = $2;
+ }
+ else {
+ print "Can't parse Content-range in '$headers'\n";
+ $error = 1;
+ }
+ push @got, [$from, $to];
+ my $chunk = substr($rcontent, 0, $to - $from + 1, "");
+ my $expect = substr($content, $from, $to - $from + 1);
+ if ($chunk ne $expect) {
+ print "Wrong content in range. Got: \n",
+ $headers, $content,
+ "Expected:\n$expect\n";
+ $error = 1;
+ }
+ }
+ if ($error) {
+ ok(0);
+ next;
+ }
+ if ($rcontent !~ /^[\s\n]*--${boundary}--[\s\n]*$/) {
+ print "error parsing final boundary: '$rcontent'\n";
+ ok(0);
+ next;
+ }
+ foreach my $w (@want) {
+ my $found;
+ foreach my $g (@got) {
+ $found = 1 if ($g->[0] <= $w->[0] && $g->[1] >= $w->[1]);
+ }
+ if (!$found) {
+ print "Data for '$w->[0]-$w->[1]' not found in response\n" . $result->content. "\n";
+ $error = 1;
+ }
+ }
+ if ($error) {
+ ok(0);
+ next;
+ }
+
+ ok (1);
+}
diff --git a/debian/perl-framework/t/apache/byterange7.t b/debian/perl-framework/t/apache/byterange7.t
new file mode 100644
index 0000000..513dfa9
--- /dev/null
+++ b/debian/perl-framework/t/apache/byterange7.t
@@ -0,0 +1,119 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_write_file);
+
+# test content-length header in byterange-requests
+# test invalid range headers
+
+my $url = "/apache/chunked/byteranges.txt";
+my $file = Apache::Test::vars('serverroot') . "/htdocs$url";
+
+my $content = "";
+$content .= sprintf("%04d", $_) for (1 .. 10000);
+t_write_file($file, $content);
+my $real_clen = length($content);
+
+
+#
+# test cases
+#
+
+# check content-length for (multi-)range responses
+my @tc_ranges_cl = ( 1, 2, 10, 50, 100);
+# send 200 response if range invalid
+my @tc_invalid = ("", ",", "7-1", "foo", "1-4,x", "1-4,5-2",
+ "100000-110000,5-2");
+# send 416 if no range satisfiable
+my %tc_416 = (
+ "100000-110000" => 416,
+ "100000-110000,200000-" => 416,
+ "1000-200000" => 206, # should be truncated until end
+ "100000-110000,1000-2000" => 206, # should ignore unsatifiable range
+ "100000-110000,2000-1000" => 200, # invalid, should ignore whole header
+ );
+
+plan tests => scalar(@tc_ranges_cl) +
+ 2 * scalar(@tc_invalid) +
+ scalar(keys %tc_416),
+ need need_lwp;
+
+foreach my $num (@tc_ranges_cl) {
+ my @ranges;
+ foreach my $i (0 .. ($num-1)) {
+ push @ranges, sprintf("%d-%d", $i * 100, $i * 100 + 1);
+ }
+ my $range = join(",", @ranges);
+ my $result = GET $url, "Range" => "bytes=$range";
+ print_result($result);
+ if ($result->code != 206) {
+ print "did not get 206\n";
+ ok(0);
+ next;
+ }
+ my $clen = $result->header("Content-Length");
+ my $body = $result->content;
+ my $blen = length($body);
+ if ($blen == $real_clen) {
+ print "Did get full content, should have gotten only parts\n";
+ ok(0);
+ next;
+ }
+ print "body length $blen\n";
+ if (defined $clen) {
+ print "Content-Length: $clen\n";
+ if ($blen != $clen) {
+ print "Content-Length does not match body\n";
+ ok(0);
+ next;
+ }
+ }
+ ok(1);
+}
+
+# test invalid range headers, with and without "bytes="
+my @tc_invalid2 = map { "bytes=" . $_ } @tc_invalid;
+foreach my $range (@tc_invalid, @tc_invalid2) {
+ my $result = GET $url, "Range" => "$range";
+ print_result($result);
+ my $code = $result->code;
+ if ($code == 206) {
+ print "got partial content response with invalid range header '$range'\n";
+ ok(0);
+ }
+ elsif ($code == 200) {
+ my $body = $result->content;
+ if ($body != $content) {
+ print "Body did not match expected content\n";
+ ok(0);
+ }
+ ok(1);
+ }
+ else {
+ print "Huh?\n";
+ ok(0);
+ }
+}
+
+# test unsatisfiable ranges headers
+foreach my $range (sort keys %tc_416) {
+ print "Sending '$range', expecting $tc_416{$range}\n";
+ my $result = GET $url, "Range" => "bytes=$range";
+ print_result($result);
+ ok($result->code == $tc_416{$range});
+}
+
+sub print_result
+{
+ my $result = shift;
+ my $code = $result->code;
+ my $cr = $result->header("Content-Range");
+ my $ct = $result->header("Content-Type");
+ my $msg = "Got $code";
+ $msg .= " multipart/byteranges"
+ if (defined $ct && $ct =~ m{^multipart/byteranges});
+ $msg .= " Range: '$cr'" if defined $cr;
+ print "$msg\n";
+}
diff --git a/debian/perl-framework/t/apache/cfg_getline.t b/debian/perl-framework/t/apache/cfg_getline.t
new file mode 100644
index 0000000..08f0231
--- /dev/null
+++ b/debian/perl-framework/t/apache/cfg_getline.t
@@ -0,0 +1,46 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_write_file);
+
+use File::Spec;
+
+# test ap_cfg_getline / ap_varbuf_cfg_getline
+
+Apache::TestRequest::user_agent(keep_alive => 1);
+
+my $dir_foo = Apache::Test::vars('serverroot') . '/htdocs/cfg_getline';
+
+# XXX: htaccess is limited to 8190 chars, would need different test
+# XXX: method to test longer lines
+my @test_cases = (100, 196 .. 202, 396 .. 402 , 596 .. 602 , 1016 .. 1030,
+ 8170 .. 8190);
+plan tests => 2 * scalar(@test_cases), need need_lwp,
+ need_module('mod_include'),
+ need_module('mod_setenvif');
+
+foreach my $len (@test_cases) {
+ my $prefix = 'SetEnvIf User-Agent ^ testvar=';
+ my $expect = 'a' x ($len - length($prefix));
+ my $file = File::Spec->catfile(Apache::Test::vars('serverroot'), 'htdocs',
+ 'apache', 'cfg_getline', '.htaccess');
+ t_write_file($file, "$prefix$expect\n");
+
+ my $response = GET('/apache/cfg_getline/index.shtml');
+ my $rc = $response->code;
+ print "Got rc $rc for length $len\n";
+ ok($rc == 200);
+
+ my $got = $response->content;
+ my $match;
+ if ($got =~ /^'$expect'/) {
+ $match = 1;
+ }
+ else {
+ print "Got $got\n",
+ "expected '$expect'\n";
+ }
+ ok($match);
+}
diff --git a/debian/perl-framework/t/apache/chunkinput.t b/debian/perl-framework/t/apache/chunkinput.t
new file mode 100644
index 0000000..2538585
--- /dev/null
+++ b/debian/perl-framework/t/apache/chunkinput.t
@@ -0,0 +1,93 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest ();
+
+my @test_strings = ("0",
+ "A\r\n1234567890\r\n0",
+ "A; ext=val\r\n1234567890\r\n0",
+ "A \r\n1234567890\r\n0", # <10 BWS
+ "A :: :: :: \r\n1234567890\r\n0", # <10 BWS multiple send
+ "A \r\n1234567890\r\n0", # >10 BWS
+ "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\r\n",
+ "A; ext=\x7Fval\r\n1234567890\r\n0",
+ " A",
+ );
+my @req_strings = ("/echo_post_chunk",
+ "/i_do_not_exist_in_your_wildest_imagination");
+
+# This is expanded out as these results...
+my @resp_strings = ("HTTP/1.1 200 OK", # "0"
+ "HTTP/1.1 404 Not Found",
+ "HTTP/1.1 200 OK", # "A"
+ "HTTP/1.1 404 Not Found",
+ "HTTP/1.1 200 OK", # "A; ext=val"
+ "HTTP/1.1 404 Not Found",
+ "HTTP/1.1 200 OK", # "A "
+ "HTTP/1.1 404 Not Found",
+ "HTTP/1.1 200 OK", # "A " + " " + " " + " " pkts
+ "HTTP/1.1 404 Not Found",
+ "HTTP/1.1 400 Bad Request", # >10 BWS
+ "HTTP/1.1 400 Bad Request",
+ "HTTP/1.1 413 Request Entity Too Large", # Overflow size
+ "HTTP/1.1 413 Request Entity Too Large",
+ "HTTP/1.1 400 Bad Request", # Ctrl in data
+ "HTTP/1.1 400 Bad Request",
+ "HTTP/1.1 400 Bad Request", # Invalid LWS
+ "HTTP/1.1 400 Bad Request",
+ );
+
+my $tests = 4 * @test_strings + 1;
+my $vars = Apache::Test::vars();
+my $module = 'default';
+my $cycle = 0;
+
+plan tests => $tests, ['echo_post_chunk'];
+
+print "testing $module\n";
+
+for my $data (@test_strings) {
+ for my $request_uri (@req_strings) {
+ my $sock = Apache::TestRequest::vhost_socket($module);
+ ok $sock;
+
+ Apache::TestRequest::socket_trace($sock);
+
+ my @elts = split("::", $data);
+
+ $sock->print("POST $request_uri HTTP/1.0\r\n");
+ $sock->print("Transfer-Encoding: chunked\r\n");
+ $sock->print("\r\n");
+ if (@elts > 1) {
+ for my $elt (@elts) {
+ $sock->print("$elt");
+ sleep 0.5;
+ }
+ $sock->print("\r\n");
+ }
+ else {
+ $sock->print("$data\r\n");
+ }
+ $sock->print("X-Chunk-Trailer: $$\r\n");
+ $sock->print("\r\n");
+
+ #Read the status line
+ chomp(my $response = Apache::TestRequest::getline($sock));
+ $response =~ s/\s$//;
+ ok t_cmp($response, $resp_strings[$cycle++], "response codes");
+
+ do {
+ chomp($response = Apache::TestRequest::getline($sock));
+ $response =~ s/\s$//;
+ }
+ while ($response ne "");
+
+ if ($cycle == 1) {
+ $response = Apache::TestRequest::getline($sock);
+ chomp($response) if (defined($response));
+ ok t_cmp($response, "$$", "trailer (pid)");
+ }
+ }
+}
diff --git a/debian/perl-framework/t/apache/contentlength.t b/debian/perl-framework/t/apache/contentlength.t
new file mode 100644
index 0000000..f141990
--- /dev/null
+++ b/debian/perl-framework/t/apache/contentlength.t
@@ -0,0 +1,83 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest ();
+
+my @test_strings = ("",
+ "0",
+ "0000000000000000000000000000000000",
+ "1000000000000000000000000000000000",
+ "-1",
+ "123abc",
+ );
+my @req_strings = ("/echo_post",
+ "/i_do_not_exist_in_your_wildest_imagination");
+
+my $resp_failure;
+if (have_min_apache_version('2.2.30')
+ && (!have_min_apache_version('2.3.0')
+ || have_min_apache_version('2.4.14'))) {
+ $resp_failure = "HTTP/1.1 400 Bad Request";
+}
+else {
+ $resp_failure = "HTTP/1.1 413 Request Entity Too Large";
+}
+# This is expanded out.
+my @resp_strings = ($resp_failure,
+ $resp_failure,
+ "HTTP/1.1 200 OK",
+ "HTTP/1.1 404 Not Found",
+ "HTTP/1.1 200 OK",
+ "HTTP/1.1 404 Not Found",
+ $resp_failure,
+ $resp_failure,
+ $resp_failure,
+ $resp_failure,
+ $resp_failure,
+ $resp_failure,
+ );
+
+my $tests = 4 * @test_strings;
+my $vars = Apache::Test::vars();
+my $module = 'default';
+my $cycle = 0;
+
+plan tests => $tests, ['eat_post'];
+
+print "testing $module\n";
+
+for my $data (@test_strings) {
+ for my $request_uri (@req_strings) {
+ my $sock = Apache::TestRequest::vhost_socket($module);
+ ok $sock;
+
+ Apache::TestRequest::socket_trace($sock);
+
+ $sock->print("POST $request_uri HTTP/1.0\r\n");
+ $sock->print("Content-Length: $data\r\n");
+ $sock->print("\r\n");
+ $sock->print("\r\n");
+
+ # Read the status line
+ chomp(my $response = Apache::TestRequest::getline($sock) || '');
+ $response =~ s/\s$//;
+
+ # Tests with empty content-length have platform-specific behaviour
+ # until 2.1.0.
+ skip
+ $data eq "" && !have_min_apache_version('2.1.0') ?
+ "skipping tests with empty C-L for httpd < 2.1.0" : 0,
+ t_cmp($response, $resp_strings[$cycle],
+ "response codes POST for $request_uri with Content-Length: $data");
+
+ $cycle++;
+
+ do {
+ chomp($response = Apache::TestRequest::getline($sock) || '');
+ $response =~ s/\s$//;
+ }
+ while ($response ne "");
+ }
+}
diff --git a/debian/perl-framework/t/apache/errordoc.t b/debian/perl-framework/t/apache/errordoc.t
new file mode 100644
index 0000000..405924b
--- /dev/null
+++ b/debian/perl-framework/t/apache/errordoc.t
@@ -0,0 +1,108 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+Apache::TestRequest::module('error_document');
+
+plan tests => 14, need_lwp;
+
+# basic ErrorDocument tests
+
+{
+ my $response = GET '/notfound.html';
+ chomp(my $content = $response->content);
+
+ ok t_cmp($response->code,
+ 404,
+ 'notfound.html code');
+
+ ok t_cmp($content,
+ qr'per-server 404',
+ 'notfound.html content');
+}
+
+{
+ my $response = GET '/inherit/notfound.html';
+ chomp(my $content = $response->content);
+
+ ok t_cmp($response->code,
+ 404,
+ '/inherit/notfound.html code');
+
+ ok t_cmp($content,
+ qr'per-server 404',
+ '/inherit/notfound.html content');
+}
+
+{
+ my $response = GET '/redefine/notfound.html';
+ chomp(my $content = $response->content);
+
+ ok t_cmp($response->code,
+ 404,
+ '/redefine/notfound.html code');
+
+ ok t_cmp($content,
+ 'per-dir 404',
+ '/redefine/notfound.html content');
+}
+
+{
+ my $response = GET '/restore/notfound.html';
+ chomp(my $content = $response->content);
+
+ ok t_cmp($response->code,
+ 404,
+ '/redefine/notfound.html code');
+
+ # 1.3 requires quotes for hard-coded messages
+ my $expected = have_min_apache_version('2.0.51') ? qr/Not Found/ :
+ have_apache(2) ? 'default' :
+ qr/Additionally, a 500/;
+
+ ok t_cmp($content,
+ $expected,
+ '/redefine/notfound.html content');
+}
+
+{
+ my $response = GET '/apache/notfound.html';
+ chomp(my $content = $response->content);
+
+ ok t_cmp($response->code,
+ 404,
+ '/merge/notfound.html code');
+
+ ok t_cmp($content,
+ 'testing merge',
+ '/merge/notfound.html content');
+}
+
+{
+ my $response = GET '/apache/etag/notfound.html';
+ chomp(my $content = $response->content);
+
+ ok t_cmp($response->code,
+ 404,
+ '/merge/merge2/notfound.html code');
+
+ ok t_cmp($content,
+ 'testing merge',
+ '/merge/merge2/notfound.html content');
+}
+
+{
+ my $response = GET '/bounce/notfound.html';
+ chomp(my $content = $response->content);
+
+ ok t_cmp($response->code,
+ 404,
+ '/bounce/notfound.html code');
+
+ ok t_cmp($content,
+ qr!expire test!,
+ '/bounce/notfound.html content');
+}
diff --git a/debian/perl-framework/t/apache/etags.t b/debian/perl-framework/t/apache/etags.t
new file mode 100644
index 0000000..6618a88
--- /dev/null
+++ b/debian/perl-framework/t/apache/etags.t
@@ -0,0 +1,170 @@
+#
+# Test the FileETag directive.
+#
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+t_debug "Checking for existence of FileETag directive\n";
+my $resp = GET('/apache/etags/test.txt');
+my $rc = $resp->code;
+t_debug "Returned $rc:";
+if ($rc == 500) {
+ t_debug "Feature not supported, skipping..",
+ " Message was:", $resp->as_string;
+ if (defined($resp->content)) {
+ t_debug $resp->content;
+ }
+ plan tests => 1..0;
+ exit;
+}
+
+#
+# The tests verify the inclusion of the different fields, and
+# inheritance, according to the directories involved. All are
+# subdirectories under /apache/etags/. The key is the path, the value
+# is the pattern the ETag response header field needs to match,
+# and the comment is the keywords on the FileETag directive in
+# the directory's .htaccess file. A pattern of "" means the header
+# field is expected to be absent.
+#
+# The things we want to test are:
+#
+# 1. That the 'All' and 'None' keywords work.
+# 2. That the 'MTime', 'INode', and 'Size' keywords work,
+# alone and in combination.
+# 3. That '+MTime', '+INode', and '+Size' work, alone and
+# in combination.
+# 4. That '-MTime', '-INode', and '-Size' work, alone and
+# in combination.
+# 5. That relative keywords work in combination with non-relative
+# ones.
+# 6. That inheritance works properly.
+#
+my $x = '[0-9a-fA-F]+';
+my $tokens_1 = "^\"$x\"\$";
+my $tokens_2 = "^\"$x-$x\"\$";
+my $tokens_3 = "^\"$x-$x-$x\"\$";
+my %expect = ($tokens_1 => "one component in ETag field",
+ $tokens_2 => "two components in ETag field",
+ $tokens_3 => "three components in ETag field",
+ "" => "field to be absent"
+ );
+my $tokens_default = have_min_apache_version("2.3.15") ? $tokens_2 : $tokens_3;
+my %tests = (
+ '/default/' => $tokens_default,
+ #
+ # First, the absolute settings in various combinations,
+ # disregarding inheritance.
+ #
+ '/m/' => $tokens_1, # MTime
+ '/i/' => $tokens_1, # INode
+ '/s/' => $tokens_1, # Size
+ '/mi/' => $tokens_2, # MTime INode
+ '/ms/' => $tokens_2, # MTime Size
+ '/is/' => $tokens_2, # INode Size
+ '/mis/' => $tokens_3, # MTime INode Size
+ '/all/' => $tokens_3, # All
+ '/none/' => "", # None
+ '/all/m/' => $tokens_1, # MTime
+ '/all/i/' => $tokens_1, # INode
+ '/all/s/' => $tokens_1, # Size
+ '/all/mi/' => $tokens_2, # MTime INode
+ '/all/ms/' => $tokens_2, # MTime Size
+ '/all/is/' => $tokens_2, # INode Size
+ '/all/mis/' => $tokens_3, # MTime INode Size
+ '/all/inherit/' => $tokens_3, # no directive
+ '/none/m/' => $tokens_1, # MTime
+ '/none/i/' => $tokens_1, # INode
+ '/none/s/' => $tokens_1, # Size
+ '/none/mi/' => $tokens_2, # MTime INode
+ '/none/ms/' => $tokens_2, # MTime Size
+ '/none/is/' => $tokens_2, # INode Size
+ '/none/mis/' => $tokens_3, # MTime INode Size
+ '/none/inherit/' => "", # no directive
+ #
+ # Now for the relative keywords. First, subtract fields
+ # in a place where they all should have been inherited.
+ #
+ '/all/minus-m/' => $tokens_2, # -MTime
+ '/all/minus-i/' => $tokens_2, # -INode
+ '/all/minus-s/' => $tokens_2, # -Size
+ '/all/minus-mi/' => $tokens_1, # -MTime -INode
+ '/all/minus-ms/' => $tokens_1, # -MTime -Size
+ '/all/minus-is/' => $tokens_1, # -INode -Size
+ '/all/minus-mis/' => "", # -MTime -INode -Size
+ #
+ # Now add them in a location where they should all be absent.
+ #
+ '/none/plus-m/' => $tokens_1, # +MTime
+ '/none/plus-i/' => $tokens_1, # +INode
+ '/none/plus-s/' => $tokens_1, # +Size
+ '/none/plus-mi/' => $tokens_2, # +MTime +INode
+ '/none/plus-ms/' => $tokens_2, # +MTime +Size
+ '/none/plus-is/' => $tokens_2, # +INode +Size
+ '/none/plus-mis/' => $tokens_3, # +MTime +INode +Size
+ #
+ # Try subtracting them below where they were added.
+ #
+ '/none/plus-mis/minus-m/' => $tokens_2, # -MTime
+ '/none/plus-mis/minus-i/' => $tokens_2, # -INode
+ '/none/plus-mis/minus-s/' => $tokens_2, # -Size
+ '/none/plus-mis/minus-mi/' => $tokens_1, # -MTime -INode
+ '/none/plus-mis/minus-ms/' => $tokens_1, # -MTime -Size
+ '/none/plus-mis/minus-is/' => $tokens_1, # -INode -Size
+ '/none/plus-mis/minus-mis/' => "", # -MTime -INode -Size
+ #
+ # Now relative settings under a non-All non-None absolute
+ # setting location.
+ #
+ '/m/plus-m/' => $tokens_1, # +MTime
+ '/m/plus-i/' => $tokens_2, # +INode
+ '/m/plus-s/' => $tokens_2, # +Size
+ '/m/plus-mi/' => $tokens_2, # +MTime +INode
+ '/m/plus-ms/' => $tokens_2, # +MTime +Size
+ '/m/plus-is/' => $tokens_3, # +INode +Size
+ '/m/plus-mis/' => $tokens_3, # +MTime +INode +Size
+ '/m/minus-m/' => "", # -MTime
+ '/m/minus-i/' => "", # -INode
+ '/m/minus-s/' => "", # -Size
+ '/m/minus-mi/' => "", # -MTime -INode
+ '/m/minus-ms/' => "", # -MTime -Size
+ '/m/minus-is/' => "", # -INode -Size
+ '/m/minus-mis/' => "" # -MTime -INode -Size
+ );
+
+my $testcount = scalar(keys(%tests));
+plan tests => $testcount;
+
+for my $key (keys(%tests)) {
+ my $uri = "/apache/etags" . $key . "test.txt";
+ my $pattern = $tests{$key};
+ t_debug "---", "HEAD $uri",
+ "Expecting " . $expect{$pattern};
+ $resp = HEAD($uri);
+ my $etag = $resp->header("ETag");
+ if (defined($etag)) {
+ t_debug "Received $etag";
+ ok ($etag =~ /$pattern/);
+ }
+ else {
+ t_debug "ETag field is missing";
+ if ($tests{$key} eq "") {
+ ok 1;
+ }
+ else {
+ t_debug "ETag field was expected";
+ ok 0;
+ }
+ }
+}
+
+#
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# End:
+#
diff --git a/debian/perl-framework/t/apache/expr.t b/debian/perl-framework/t/apache/expr.t
new file mode 100644
index 0000000..7d62bc0
--- /dev/null
+++ b/debian/perl-framework/t/apache/expr.t
@@ -0,0 +1,327 @@
+use strict;
+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 File::Spec;
+
+# test ap_expr
+
+Apache::TestRequest::user_agent(keep_alive => 1);
+
+my $file_foo = Apache::Test::vars('serverroot') . '/htdocs/expr/index.html';
+my $dir_foo = Apache::Test::vars('serverroot') . '/htdocs/expr';
+my $file_notexist = Apache::Test::vars('serverroot') . '/htdocs/expr/none';
+my $file_zero = Apache::Test::vars('serverroot') . '/htdocs/expr/zero';
+my $url_foo = '/apache/';
+my $url_notexist = '/apache/expr/none';
+my @test_cases = (
+ [ 'true' => 1 ],
+ [ 'false' => 0 ],
+ [ 'foo' => undef ],
+ # integer comparison
+ [ '1 -eq 01' => 1 ],
+ [ '1 -eq 2' => 0 ],
+ [ '1 -ne 2' => 1 ],
+ [ '1 -ne 1' => 0 ],
+ [ '1 -lt 02' => 1 ],
+ [ '1 -lt 1' => 0 ],
+ [ '1 -le 2' => 1 ],
+ [ '1 -le 1' => 1 ],
+ [ '2 -gt 1' => 1 ],
+ [ '1 -gt 1' => 0 ],
+ [ '2 -ge 1' => 1 ],
+ [ '1 -ge 1' => 1 ],
+ [ '1 -gt -1' => 1 ],
+ # string comparison
+ [ q{'aa' == 'aa'} => 1 ],
+ [ q{'aa' == 'b'} => 0 ],
+ [ q{'aa' = 'aa'} => 1 ],
+ [ q{'aa' = 'b'} => 0 ],
+ [ q{'aa' != 'b'} => 1 ],
+ [ q{'aa' != 'aa'} => 0 ],
+ [ q{'aa' < 'b'} => 1 ],
+ [ q{'aa' < 'aa'} => 0 ],
+ [ q{'aa' <= 'b'} => 1 ],
+ [ q{'aa' <= 'aa'} => 1 ],
+ [ q{'b' > 'aa'} => 1 ],
+ [ q{'aa' > 'aa'} => 0 ],
+ [ q{'b' >= 'aa'} => 1 ],
+ [ q{'aa' >= 'aa'} => 1 ],
+ # string operations/whitespace handling
+ [ q{'a' . 'b' . 'c' = 'abc'} => 1 ],
+ [ q{'a' .'b'. 'c' = 'abc'} => 1 ],
+ [ q{ 'a' .'b'. 'c'='abc' } => 1 ],
+ [ q{'a1c' = 'a'. 1. 'c'} => 1 ],
+ [ q{req('foo') . 'bar' = 'bar'} => 1 ],
+ [ q[%{req:foo} . 'bar' = 'bar'] => 1 ],
+ [ q['x'.%{req:foo} . 'bar' = 'xbar'] => 1 ],
+ [ q[%{req:User-Agent} . 'bar' != 'bar'] => 1 ],
+ [ q['%{req:User-Agent}' . 'bar' != 'bar'] => 1 ],
+ [ q['%{TIME}' . 'bar' != 'bar'] => 1 ],
+ [ q[%{TIME} != ''] => 1 ],
+ # string lists
+ [ q{'a' -in { 'b', 'a' } } => 1 ],
+ [ q{'a' -in { 'b', 'c' } } => 0 ],
+ # regexps
+ [ q[ 'abc' =~ /bc/ ] => 1 ],
+ [ q[ 'abc' =~ /BC/i ] => 1 ],
+ [ q[ 'abc' !~ m!bc! ] => 0 ],
+ [ q[ 'abc' !~ m!BC!i ] => 0 ],
+ [ q[ $0 == '' ] => 1 ],
+ [ q[ $1 == '' ] => 1 ],
+ [ q[ $9 == '' ] => 1 ],
+ [ q[ '$0' == '' ] => 1 ],
+ [ q[ 'abc' =~ /(bc)/ && $0 == 'bc' ] => 1 ],
+ [ q[ 'abc' =~ /(bc)/ && $1 == 'bc' ] => 1 ],
+ [ q[ 'abc' =~ /b(.)/ && $1 == 'c' ] => 1 ],
+ # $0 .. $9 are only populated if there are capturing parens
+ [ q[ 'abc' =~ /bc/ && $0 == '' ] => 1 ],
+ [ q[ 'abc' =~ /(bc)/ && 'xy' =~ /x/ && $0 == 'bc' ] => 1 ],
+ # Attempt to blow up when more matches are present than 'typical' $0 .. $9
+ [ q[ 'abcdefghijklm' =~ /(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)/ && $2 == 'c' ] => 1 ],
+ # variables
+ [ q[%{TIME_YEAR} =~ /^\d{4}$/] => 1 ],
+ [ q[%{TIME_YEAR} =~ /^\d{3}$/] => 0 ],
+ [ q[%{TIME_MON} -gt 0 && %{TIME_MON} -le 12 ] => 1 ],
+ [ q[%{TIME_DAY} -gt 0 && %{TIME_DAY} -le 31 ] => 1 ],
+ [ q[%{TIME_HOUR} -ge 0 && %{TIME_HOUR} -lt 24 ] => 1 ],
+ [ q[%{TIME_MIN} -ge 0 && %{TIME_MIN} -lt 60 ] => 1 ],
+ [ q[%{TIME_SEC} -ge 0 && %{TIME_SEC} -lt 60 ] => 1 ],
+ [ q[%{TIME} =~ /^\d{14}$/] => 1 ],
+ [ q[%{API_VERSION} -gt 20101001 ] => 1 ],
+ [ q[%{REQUEST_METHOD} == 'GET' ] => 1 ],
+ [ q['x%{REQUEST_METHOD}' == 'xGET' ] => 1 ],
+ [ q['x%{REQUEST_METHOD}y' == 'xGETy' ] => 1 ],
+ [ q[%{REQUEST_SCHEME} == 'http' ] => 1 ],
+ [ q[%{HTTPS} == 'off' ] => 1 ],
+ [ q[%{REQUEST_URI} == '/apache/expr/index.html' ] => 1 ],
+ # request headers
+ [ q[%{req:referer} = 'SomeReferer' ] => 1 ],
+ [ q[req('Referer') = 'SomeReferer' ] => 1 ],
+ [ q[http('Referer') = 'SomeReferer' ] => 1 ],
+ [ q[%{HTTP_REFERER} = 'SomeReferer' ] => 1 ],
+ [ q[req('User-Agent') = 'SomeAgent' ] => 1 ],
+ [ q[%{HTTP_USER_AGENT} = 'SomeAgent' ] => 1 ],
+ [ q[req('SomeHeader') = 'SomeValue' ] => 1 ],
+ [ q[req('SomeHeader2') = 'SomeValue' ] => 0 ],
+ # functions
+ [ q[toupper('abC12d') = 'ABC12D' ] => 1 ],
+ [ q[tolower('abC12d') = 'abc12d' ] => 1 ],
+ [ q[escape('?') = '%3f' ] => 1 ],
+ [ q[unescape('%3f') = '?' ] => 1 ],
+ [ q[toupper(escape('?')) = '%3F' ] => 1 ],
+ [ q[tolower(toupper(escape('?'))) = '%3f' ] => 1 ],
+ [ q[%{toupper:%{escape:?}} = '%3F' ] => 1 ],
+ [ q[file('] . $file_foo . q[') = 'foo\n' ] => 1 ],
+ # unary operators
+ [ q[-n ''] => 0 ],
+ [ q[-z ''] => 1 ],
+ [ q[-n '1'] => 1 ],
+ [ q[-z '1'] => 0 ],
+ # IP match
+ [ q[-R 'abc'] => undef ],
+ [ q[-R %{REMOTE_ADDR}] => undef ],
+ [ q[-R '240.0.0.0'] => 0 ],
+ [ q[-R '240.0.0.0/8'] => 0 ],
+ [ q[-R 'ff::/8'] => 0 ],
+ [ q[-R '127.0.0.1' || -R '::1'] => 1 ],
+ [ q['127.0.0.1' -ipmatch 'abc'] => undef ],
+ [ q['127.0.0.1' -ipmatch %{REMOTE_ADDR}] => undef ],
+ [ q['127.0.0.1' -ipmatch '240.0.0.0'] => 0 ],
+ [ q['127.0.0.1' -ipmatch '240.0.0.0/8'] => 0 ],
+ [ q['127.0.0.1' -ipmatch 'ff::/8'] => 0 ],
+ [ q['127.0.0.1' -ipmatch '127.0.0.0/8'] => 1 ],
+ # fn/strmatch
+ [ q['foo' -strmatch '*o'] => 1 ],
+ [ q['fo/o' -strmatch 'f*'] => 1 ],
+ [ q['foo' -strmatch 'F*'] => 0 ],
+ [ q['foo' -strcmatch 'F*'] => 1 ],
+ [ q['foo' -strmatch 'g*'] => 0 ],
+ [ q['foo' -strcmatch 'g*'] => 0 ],
+ [ q['a/b' -fnmatch 'a*'] => 0 ],
+ [ q['a/b' -fnmatch 'a/*'] => 1 ],
+ # error handling
+ [ q['%{foo:User-Agent}' != 'bar'] => undef ],
+ [ q[%{foo:User-Agent} != 'bar'] => undef ],
+ [ q[foo('bar') = 'bar'] => undef ],
+ [ q[%{FOO} != 'bar'] => undef ],
+ [ q['bar' = bar] => undef ],
+);
+
+#
+# Bool logic:
+# Test all combinations with 0 to 2 '||' or '&&' operators
+#
+my @bool_base = (
+ [ q[true] => 1 ],
+);
+push @bool_base, (
+ [ q[-z ''] => 1 ],
+ [ q[-n 'x'] => 1 ],
+ [ q[false] => 0 ],
+ [ q[-n ''] => 0 ],
+ [ q[-z 'x'] => 0 ],
+) if 0; # This produces an exessive number of tests for normal operation
+
+# negation function: perl's "!" returns undef for false, but we need 0
+sub neg
+{
+ return (shift) ? 0 : 1;
+}
+# also test combinations with '!' operator before each operand
+@bool_base = (@bool_base, map { ["!$_->[0]" => neg($_->[1]) ] } @bool_base);
+# now create the test cases
+my @bool_test_cases;
+foreach my $ex1 (@bool_base) {
+ my ($e1, $r1) = @$ex1;
+ push @bool_test_cases, [ $e1 => $r1 ];
+ foreach my $ex2 (@bool_base) {
+ my ($e2, $r2) = @$ex2;
+ push @bool_test_cases, [ "$e1 && $e2" => ($r1 && $r2) ];
+ push @bool_test_cases, [ "$e1 || $e2" => ($r1 || $r2) ];
+ foreach my $ex3 (@bool_base) {
+ my ($e3, $r3) = @$ex3;
+ foreach my $op1 ("||", "&&") {
+ foreach my $op2 ("||", "&&") {
+ my $r = eval "$r1 $op1 $r2 $op2 $r3";
+ push @bool_test_cases, [ "$e1 $op1 $e2 $op2 $e3" => $r];
+ }
+ }
+ }
+ }
+}
+push @test_cases, @bool_test_cases;
+# also test combinations with '!' operator before the whole expression
+push @test_cases, map { ["!($_->[0])" => neg($_->[1]) ] } @bool_test_cases;
+
+if (have_min_apache_version("2.3.13")) {
+ push(@test_cases, (
+ # functions
+ [ q[filesize('] . $file_foo . q[') = 4 ] => 1 ],
+ [ q[filesize('] . $file_notexist . q[') = 0 ] => 1 ],
+ [ q[filesize('] . $file_zero . q[') = 0 ] => 1 ],
+ # unary operators
+ [ qq[-d '$file_foo' ] => 0 ],
+ [ qq[-e '$file_foo' ] => 1 ],
+ [ qq[-f '$file_foo' ] => 1 ],
+ [ qq[-s '$file_foo' ] => 1 ],
+ [ qq[-d '$file_zero' ] => 0 ],
+ [ qq[-e '$file_zero' ] => 1 ],
+ [ qq[-f '$file_zero' ] => 1 ],
+ [ qq[-s '$file_zero' ] => 0 ],
+ [ qq[-d '$dir_foo' ] => 1 ],
+ [ qq[-e '$dir_foo' ] => 1 ],
+ [ qq[-f '$dir_foo' ] => 0 ],
+ [ qq[-s '$dir_foo' ] => 0 ],
+ [ qq[-d '$file_notexist' ] => 0 ],
+ [ qq[-e '$file_notexist' ] => 0 ],
+ [ qq[-f '$file_notexist' ] => 0 ],
+ [ qq[-s '$file_notexist' ] => 0 ],
+ [ qq[-F '$file_foo' ] => 1 ],
+ [ qq[-F '$file_notexist' ] => 0 ],
+ [ qq[-U '$url_foo' ] => 1 ],
+ [ qq[-U '$url_notexist' ] => 0 ],
+ ));
+}
+
+if (have_min_apache_version("2.4.5")) {
+ push(@test_cases, (
+ [ qq[sha1('foo') = '0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33' ] => 1 ],
+ [ qq[md5('foo') = 'acbd18db4cc2f85cedef654fccc4a4d8' ] => 1 ],
+ [ qq[base64('foo') = 'Zm9v' ] => 1 ],
+ [ qq[unbase64('Zm9vMg==') = 'foo2' ] => 1 ],
+ ));
+}
+
+if (have_min_apache_version("2.5")) {
+ my $SAN_one = "email:<redacted1>, email:<redacted2>, " .
+ "IP Address:127.0.0.1, IP Address:0:0:0:0:0:0:0:1, " .
+ "IP Address:192.168.169.170";
+ my $SAN_tuple = "'email:<redacted1>', 'email:<redacted2>', " .
+ "'IP Address:127.0.0.1', 'IP Address:0:0:0:0:0:0:0:1', " .
+ "'IP Address:192.168.169.170'";
+ my $SAN_list_one = "{ '$SAN_one' }";
+ my $SAN_list_tuple = "{ $SAN_tuple }";
+
+ my $SAN_split = '.*?IP Address:([^,]+)';
+
+ push(@test_cases, (
+ [ "join {'a', 'b', 'c'} == 'abc'" => 1 ],
+ [ "join($SAN_list_tuple, ', ') == " .
+ "'email:<redacted1>, email:<redacted2>, " .
+ "IP Address:127.0.0.1, IP Address:0:0:0:0:0:0:0:1, " .
+ "IP Address:192.168.169.170'" => 1 ],
+ [ "join($SAN_list_tuple, ', ') == join $SAN_list_one" => 1 ],
+ [ "join(split(s/$SAN_split/\$1/, $SAN_list_tuple), ', ') == " .
+ "'email:<redacted1>, email:<redacted2>, " .
+ "127.0.0.1, 0:0:0:0:0:0:0:1, 192.168.169.170'" => 1 ],
+ [ "join(split(s/$SAN_split/\$1/, $SAN_list_one), ', ') == " .
+ "'127.0.0.1, 0:0:0:0:0:0:0:1, 192.168.169.170'" => 1 ],
+ [ "'IP Address:192.168.169.170' -in $SAN_list_tuple" => 1 ],
+ [ "'192.168.169.170' -in split s/$SAN_split/\$1/, $SAN_list_tuple" => 1 ],
+ [ "'0:0:0:0:0:0:0:1' -in split s/$SAN_split/\$1/, $SAN_list_one" => 1 ],
+ [ "%{REMOTE_ADDR} -in split s/$SAN_split/\$1/, $SAN_list_one" => 1 ],
+ [ "'email:<redacted1>' -in split s/$SAN_split/\$1/, $SAN_list_tuple" => 1 ],
+ [ "'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],
+ ));
+}
+
+plan tests => scalar(@test_cases) + 1,
+ need need_lwp,
+ need_module('mod_authz_core'),
+ need_min_apache_version('2.3.9');
+
+t_start_error_log_watch();
+
+my %rc_map = ( 500 => 'parse error', 403 => 'true', 200 => 'false');
+foreach my $t (@test_cases) {
+ my ($expr, $expect) = @{$t};
+
+ write_htaccess($expr);
+
+ my $response = GET('/apache/expr/index.html',
+ 'SomeHeader' => 'SomeValue',
+ 'User-Agent' => 'SomeAgent',
+ 'Referer' => 'SomeReferer');
+ my $rc = $response->code;
+ if (!defined $expect) {
+ print qq{Should get parse error for "$expr", got $rc_map{$rc}\n};
+ ok($rc == 500);
+ }
+ elsif ($expect) {
+ print qq{"$expr" should evaluate to true, got $rc_map{$rc}\n};
+ ok($rc == 403);
+ }
+ else {
+ print qq{"$expr" should evaluate to false, got $rc_map{$rc}\n};
+ ok($rc == 200);
+ }
+}
+
+my @loglines = t_finish_error_log_watch();
+my @evalerrors = grep { /internal evaluation error/i } @loglines;
+my $num_errors = scalar @evalerrors;
+print "Error log should not have 'Internal evaluation error' entries, found $num_errors\n";
+ok($num_errors == 0);
+
+exit 0;
+
+### sub routines
+sub write_htaccess
+{
+ my $expr = shift;
+ my $file = File::Spec->catfile(Apache::Test::vars('serverroot'), 'htdocs', 'apache', 'expr', '.htaccess');
+ t_write_file($file, << "EOF" );
+<If "$expr">
+ Require all denied
+</If>
+EOF
+}
+
diff --git a/debian/perl-framework/t/apache/expr_string.t b/debian/perl-framework/t/apache/expr_string.t
new file mode 100644
index 0000000..4682d4a
--- /dev/null
+++ b/debian/perl-framework/t/apache/expr_string.t
@@ -0,0 +1,123 @@
+use strict;
+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 t_cmp);
+
+use File::Spec;
+
+use Time::HiRes qw(usleep);
+
+# test ap_expr
+
+Apache::TestRequest::user_agent(keep_alive => 1);
+
+# The left-hand values are written into the config file as-is, i.e.
+# necessary quoting for the config file parser needs to be included
+# explicitly.
+my @test_cases = (
+ [ 'foo' => 'foo' ],
+ [ '%{req:SomeHeader}' => 'SomeValue' ],
+ [ '%{' => undef ],
+ [ '%' => '%' ],
+ [ '}' => '}' ],
+ [ q{\"} => q{"} ],
+ [ q{\'} => q{'} ],
+ [ q{"\%{req:SomeHeader}"} => '%{req:SomeHeader}' ],
+ [ '%{tolower:IDENT}' => 'ident' ],
+ [ '%{tolower:%{REQUEST_METHOD}}' => 'get' ],
+);
+
+if (have_min_apache_version("2.5")) {
+ my $SAN_one = "email:<redacted1>, email:<redacted2>, " .
+ "IP Address:127.0.0.1, IP Address:0:0:0:0:0:0:0:1, " .
+ "IP Address:192.168.169.170";
+ my $SAN_tuple = "'email:<redacted1>', 'email:<redacted2>', " .
+ "'IP Address:127.0.0.1', 'IP Address:0:0:0:0:0:0:0:1', " .
+ "'IP Address:192.168.169.170'";
+ my $SAN_list_one = "{ '$SAN_one' }";
+ my $SAN_list_tuple = "{ $SAN_tuple }";
+
+ push(@test_cases, (
+ [ qq["%{tolower:%{:toupper(%{REQUEST_METHOD}):}}"] => "get" ],
+ [ qq["%{: join $SAN_list_one :}"] => "$SAN_one" ],
+ [ qq["%{: join($SAN_list_tuple, ', ') :}"] => "$SAN_one" ],
+ [ qq['%{tolower:"IDENT"}'] => '"ident"' ],
+ [ qq["%{: 'IP Address:%{REMOTE_ADDR}' -in split/, /, join $SAN_list_one :}"]
+ => "true" ],
+ ));
+}
+
+my $successful_expected = scalar(grep { defined $_->[1] } @test_cases);
+
+plan tests => scalar(@test_cases) * 2 + $successful_expected,
+ need need_lwp,
+ need_module('mod_log_debug');
+foreach my $t (@test_cases) {
+ my ($expr, $expect) = @{$t};
+
+ write_htaccess($expr);
+
+ t_start_error_log_watch();
+ my $response = GET('/apache/expr/index.html',
+ '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
+ } @loglines;
+ my $num_errors = scalar @evalerrors;
+ print "Error log should not have 'Internal evaluation error' or " .
+ "'flex scanner jammed' entries, found $num_errors:\n@evalerrors\n"
+ if $num_errors;
+ ok($num_errors == 0);
+
+ my $rc = $response->code;
+
+ if (!defined $expect) {
+ print qq{Should get parse error (500) for "$expr", got $rc\n};
+ ok($rc == 500);
+ }
+ else {
+ print qq{Expected return code 200, got $rc for '$expr'\n};
+ ok($rc == 200);
+ my @msg = grep { /log_debug:info/ } @loglines;
+ if (scalar @msg != 1) {
+ print "expected 1 message, got " . scalar @msg . ":\n@msg\n";
+ ok(0);
+ }
+ elsif ($msg[0] =~ m{^(?:\[ # opening '['
+ [^\]]+ # anything but a ']'
+ \] # closing ']'
+ [ ] # trailing space
+ ){4} # repeat 4 times (timestamp, level, pid, client IP)
+ (.*?) # The actual message logged by LogMessage
+ (,[ ]referer # either trailing referer (LogLevel info)
+ | # or
+ [ ]\(log_transaction) # trailing hook info (LogLevel debug and higher)
+ }x ) {
+ my $result = $1;
+ ok t_cmp($result, $expect, "log message @msg didn't match");
+ }
+ else {
+ print "Can't extract expr result from log message:\n@msg\n";
+ ok(0);
+ }
+ }
+}
+
+exit 0;
+
+### sub routines
+sub write_htaccess
+{
+ my $expr = shift;
+ my $file = File::Spec->catfile(Apache::Test::vars('serverroot'), 'htdocs', 'apache', 'expr', '.htaccess');
+ t_write_file($file, << "EOF" );
+LogMessage $expr
+EOF
+}
diff --git a/debian/perl-framework/t/apache/getfile.t b/debian/perl-framework/t/apache/getfile.t
new file mode 100644
index 0000000..3df2faf
--- /dev/null
+++ b/debian/perl-framework/t/apache/getfile.t
@@ -0,0 +1,24 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest ();
+use Apache::TestCommon ();
+
+Apache::TestCommon::run_files_test(\&verify);
+
+sub verify {
+ my($ua, $url, $file) = @_;
+
+ my $flen = -s $file;
+ my $received = 0;
+
+ $ua->do_request(GET => $url,
+ sub {
+ my($chunk, $res) = @_;
+ $received += length $chunk;
+ });
+
+ ok t_cmp($received, $flen, "download of $url");
+}
diff --git a/debian/perl-framework/t/apache/headers.t b/debian/perl-framework/t/apache/headers.t
new file mode 100644
index 0000000..2412eff
--- /dev/null
+++ b/debian/perl-framework/t/apache/headers.t
@@ -0,0 +1,96 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+my %headers;
+
+my $hasfix = 0;
+if (have_min_apache_version("2.4.0")) {
+ if (have_min_apache_version("2.4.24")) {
+ $hasfix = 1;
+ }
+}
+elsif (have_min_apache_version("2.2.32")) {
+ $hasfix = 1;
+}
+if ($hasfix) {
+ %headers = (
+ "Hello:World\r\n" => ["Hello", "World"],
+ "Hello: World\r\n" => ["Hello", "World"],
+ "Hello: World \r\n" => ["Hello", "World"],
+ "Hello: World \t \r\n" => ["Hello", "World"],
+ "Hello: Foo\r\n Bar\r\n" => ["Hello", "Foo Bar"],
+ "Hello: Foo\r\n\tBar\r\n" => ["Hello", "Foo Bar"],
+ "Hello: Foo\r\n Bar\r\n" => ["Hello", "Foo Bar"],
+ "Hello: Foo \t \r\n Bar\r\n" => ["Hello", "Foo Bar"],
+ "Hello: Foo\r\n \t Bar\r\n" => ["Hello", "Foo Bar"],
+ );
+}
+else {
+ %headers = (
+ "Hello:World\n" => ["Hello", "World"],
+ "Hello : World\n" => ["Hello", "World"],
+ "Hello : World \n" => ["Hello", "World"],
+ "Hello \t : World \n" => ["Hello", "World"],
+ "Hello: Foo\n Bar\n" => ["Hello", "Foo Bar"],
+ "Hello: Foo\n\tBar\n" => ["Hello", "Foo\tBar"],
+ "Hello: Foo\n Bar\n" => ["Hello", qr/Foo +Bar/],
+ "Hello: Foo \n Bar\n" => ["Hello", qr/Foo +Bar/],
+ );
+}
+
+my $uri = "/modules/cgi/env.pl";
+
+plan tests => (scalar keys %headers) * 3, need_cgi;
+
+foreach my $key (sort keys %headers) {
+
+ print "testing: $key";
+
+ my $sock = Apache::TestRequest::vhost_socket('default');
+ ok $sock;
+
+ Apache::TestRequest::socket_trace($sock);
+
+ $sock->print("GET $uri HTTP/1.0\r\n");
+ $sock->print($key);
+ $sock->print("\r\n");
+
+ # Read the status line
+ chomp(my $response = Apache::TestRequest::getline($sock) || '');
+ $response =~ s/\s$//;
+
+ ok t_cmp($response, qr{HTTP/1\.. 200 OK}, "response success");
+
+ my $line;
+
+ do {
+ chomp($line = Apache::TestRequest::getline($sock) || '');
+ $line =~ s/\s$//;
+ }
+ while ($line ne "");
+
+ my $found = 0;
+
+ my ($name, $value) = ($headers{$key}[0], $headers{$key}[1]);
+
+ do {
+ chomp($line = Apache::TestRequest::getline($sock) || '');
+ $line =~ s/\r?\n?$//;
+ if ($line ne "" && !$found) {
+ my @part = split(/ = /, $line);
+ if (@part && $part[0] eq "HTTP_" . uc($name)) {
+ print "header: [".$part[1]."] vs [".$value."]\n";
+ ok t_cmp $part[1], $value, "compare header $name value";
+ $found = 1;
+ }
+ }
+ }
+ while ($line ne "");
+
+ ok 0 unless $found;
+}
+
diff --git a/debian/perl-framework/t/apache/hostcheck.t b/debian/perl-framework/t/apache/hostcheck.t
new file mode 100644
index 0000000..b9e11aa
--- /dev/null
+++ b/debian/perl-framework/t/apache/hostcheck.t
@@ -0,0 +1,113 @@
+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 strict VH, msg
+ [ "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" => 200, 400, "ok"],
+ [ "GET / HTTP/1.1\r\nHost: localhost:1\r\n\r\n" => 200, 400, "port ignored"],
+ [ "GET / HTTP/1.1\r\nHost: notlisted\r\n\r\n" => 200, 400, "name not listed"],
+ [ "GET / HTTP/1.1\r\nHost: 127.0.0.1\r\n\r\n" => 200, 400, "IP not in serveralias/servername"],
+ [ "GET / HTTP/1.1\r\nHost: default-strict\r\n\r\n" => 200, 200, "NVH matches in default server"],
+ [ "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');
+
+
+foreach my $vhosts ((["default" => 1], ["core" => 2])) {
+ my $vhost = $vhosts->[0];
+ my $expect_column = $vhosts->[1];
+
+ foreach my $t (@test_cases) {
+ my $req = $t->[0];
+ my $expect = $t->[$expect_column];
+ my $desc = $t->[3];
+ my $decoded;
+
+ my $sock = Apache::TestRequest::vhost_socket($vhost);
+ if (!$sock) {
+ print "# failed to connect\n";
+ ok(0);
+ next;
+ }
+
+ print "# SENDING to " . peer($sock) . "\n# $req\n";
+ $sock->print($req);
+ $sock->shutdown(1);
+ $req = escape($req);
+
+ 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);
+ 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/http_strict.t b/debian/perl-framework/t/apache/http_strict.t
new file mode 100644
index 0000000..2434fc3
--- /dev/null
+++ b/debian/perl-framework/t/apache/http_strict.t
@@ -0,0 +1,243 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use MIME::Base64;
+use Data::Dumper;
+use HTTP::Response;
+
+
+my $test_underscore = defined(&need_min_apache_fix) ?
+ need_min_apache_fix("2.4.34", "2.5.1") :
+ need_min_apache_version('2.4.34');
+
+# possible expected results:
+# 0: any HTTP error
+# 1: any HTTP success
+# 200-500: specific HTTP status code
+# undef: HTTPD should drop connection without error message
+
+my @test_cases = (
+ [ "GET / HTTP/1.0\r\n\r\n" => 1],
+ [ "GET / HTTP/1.0\n\n" => 1, 400],
+ [ "get / HTTP/1.0\r\n\r\n" => 501],
+ [ "G ET / HTTP/1.0\r\n\r\n" => 400],
+ [ "G\0ET / HTTP/1.0\r\n\r\n" => 400],
+ [ "G/T / HTTP/1.0\r\n\r\n" => 501, 400],
+ [ "GET /\0 HTTP/1.0\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\0\r\n\r\n" => 400],
+ [ "GET\f/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET\r/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET\t/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET / HTT/1.0\r\n\r\n" => 0],
+ [ "GET / HTTP/1.0\r\nHost: localhost\r\n\r\n" => 1],
+ [ "GET / HTTP/2.0\r\nHost: localhost\r\n\r\n" => 1],
+ [ "GET / HTTP/1.2\r\nHost: localhost\r\n\r\n" => 1],
+ [ "GET / HTTP/1.11\r\nHost: localhost\r\n\r\n" => 400],
+ [ "GET / HTTP/10.0\r\nHost: localhost\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0 \r\nHost: localhost\r\n\r\n" => 200, 400],
+ [ "GET / HTTP/1.0 x\r\nHost: localhost\r\n\r\n" => 400],
+ [ "GET / HTTP/\r\nHost: localhost\r\n\r\n" => 0],
+ [ "GET / HTTP/0.9\r\n\r\n" => 0],
+ [ "GET / HTTP/0.8\r\n\r\n" => 0],
+ [ "GET /\x01 HTTP/1.0\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nFoo: bar\r\n\r\n" => 200],
+ [ "GET / HTTP/1.0\r\nFoo:bar\r\n\r\n" => 200],
+ [ "GET / HTTP/1.0\r\nFoo: b\0ar\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nFoo: b\x01ar\r\n\r\n" => 200, 400],
+ [ "GET / HTTP/1.0\r\nFoo\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nFoo bar\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\n: bar\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nX: bar\r\n\r\n" => 200],
+ [ "GET / HTTP/1.0\r\nFoo bar:bash\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nFoo :bar\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\n Foo:bar\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nF\x01o: bar\r\n\r\n" => 200, 400],
+ [ "GET / HTTP/1.0\r\nF\ro: bar\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nF\to: bar\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nFo: b\tar\r\n\r\n" => 200],
+ [ "GET / HTTP/1.0\r\nFo: bar\r\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\r" => undef, undef],
+ [ "GET /\r\n" => 90, undef],
+ [ "GET /#frag HTTP/1.0\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nHost: localhost\r\n" .
+ "Host: localhost\r\n\r\n" => 200, 400],
+ [ "GET http://017700000001/ HTTP/1.0\r\n\r\n" => 200, 400],
+ [ "GET http://0x7f.1/ HTTP/1.0\r\n\r\n" => 200, 400],
+ [ "GET http://127.0.0.1/ HTTP/1.0\r\n\r\n" => 200],
+ [ "GET http://127.01.0.1/ HTTP/1.0\r\n\r\n" => 200, 400],
+ [ "GET http://%3127.0.0.1/ HTTP/1.0\r\n\r\n" => 200, 400],
+ [ "GET / HTTP/1.0\r\nHost: localhost:80\r\n" .
+ "Host: localhost:80\r\n\r\n" => 200, 400],
+ [ "GET / HTTP/1.0\r\nHost: localhost:80 x\r\n\r" => 400],
+ [ "GET http://localhost:80/ HTTP/1.0\r\n\r\n" => 200],
+ [ "GET http://localhost:80x/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET http://localhost:80:80/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET http://localhost::80/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET http://foo\@localhost:80/ HTTP/1.0\r\n\r\n" => 200, 400],
+ [ "GET http://[::1]/ HTTP/1.0\r\n\r\n" => 1],
+ [ "GET http://[::1:2]/ HTTP/1.0\r\n\r\n" => 1],
+ [ "GET http://[4712::abcd]/ HTTP/1.0\r\n\r\n" => 1],
+ [ "GET http://[4712::abcd:1]/ HTTP/1.0\r\n\r\n" => 1],
+ [ "GET http://[4712::abcd::]/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET http://[4712:abcd::]/ HTTP/1.0\r\n\r\n" => 1],
+ [ "GET http://[4712::abcd]:8000/ HTTP/1.0\r\n\r\n" => 1],
+ [ "GET http://4713::abcd:8001/ HTTP/1.0\r\n\r\n" => 400],
+ [ "GET / HTTP/1.0\r\nHost: [::1]\r\n\r\n" => 1],
+ [ "GET / HTTP/1.0\r\nHost: [::1:2]\r\n\r\n" => 1],
+ [ "GET / HTTP/1.0\r\nHost: [4711::abcd]\r\n\r\n" => 1],
+ [ "GET / HTTP/1.0\r\nHost: [4711::abcd:1]\r\n\r\n" => 1],
+ [ "GET / HTTP/1.0\r\nHost: [4711:abcd::]\r\n\r\n" => 1],
+ [ "GET / HTTP/1.0\r\nHost: [4711::abcd]:8000\r\n\r\n" => 1],
+ [ "GET / HTTP/1.0\r\nHost: 4714::abcd:8001\r\n\r\n" => 200, 400],
+ [ "GET / HTTP/1.0\r\nHost: abc\xa0\r\n\r\n" => 200, 400],
+ [ "GET / HTTP/1.0\r\nHost: abc\\foo\r\n\r\n" => 400],
+ [ "GET http://foo/ HTTP/1.0\r\nHost: bar\r\n\r\n" => 200],
+ [ "GET http://foo:81/ HTTP/1.0\r\nHost: bar\r\n\r\n" => 200],
+ [ "GET http://[::1]:81/ HTTP/1.0\r\nHost: bar\r\n\r\n" => 200],
+ [ "GET http://10.0.0.1:81/ HTTP/1.0\r\nHost: bar\r\n\r\n" => 200],
+ [ "GET / HTTP/1.0\r\nHost: foo-bar.example.com\r\n\r\n" => 200],
+ [ "GET / HTTP/1.0\r\nHost: foo_bar.example.com\r\n\r\n" => 200, 200, $test_underscore],
+ [ "GET http://foo_bar/ HTTP/1.0\r\n\r\n" => 200, 200, $test_underscore],
+
+ #
+ # tests for response headers
+ #
+ # Everything after the leading "R" will be sent encoded
+ # to .../send_hdr.pl which will decode it and include it
+ # in the response headers.
+ [ "R" . "Foo: bar" => 200 ],
+ [ "R" . "Foo:" => 200 ],
+ [ "R" . ": bar" => 500 ],
+ [ "R" . "F\0oo: bar" => 500 ],
+ [ "R" . "F\x01oo: bar" => 500 ],
+ [ "R" . "F\noo: bar" => 500 ],
+ [ "R" . "Foo: b\tar" => 200 ],
+ [ "R" . "Foo: b\x01ar" => 500 ],
+ # XXX ap_scan_script_header() eats the \r
+ #[ "R" . "F\roo: bar" => 500 ],
+ #[ "R" . "Foo: bar\rBaz: h" => 500 ],
+
+ #
+ # implementation regression tests
+ #
+ # `Header always set <bad value>` followed by a <bad field name>
+ # should not cause a recursion loop
+ [ "GET /regression-header HTTP/1.1\r\nHost:localhost\r\n\r\n" => 500, 500,
+ have_module qw(mod_headers) ],
+);
+
+my $test_fold = defined(&need_min_apache_fix) ?
+ need_min_apache_fix("2.2.33", "2.4.26", "2.5.0") :
+ need_min_apache_version('2.4.26');
+
+plan tests => scalar(@test_cases) * 2 + $test_fold * 2,
+ need_min_apache_version('2.2.32');
+
+foreach my $vhosts ((["http_unsafe" => 1], ["http_strict" => 2])) {
+ my $vhost = $vhosts->[0];
+ my $expect_column = $vhosts->[1];
+
+ foreach my $t (@test_cases) {
+ my $req = $t->[0];
+ my $expect = $t->[$expect_column];
+ $expect = $t->[1] if (! defined $expect);
+ my $cond = $t->[3];
+ my $decoded;
+
+ if ($req =~ s/^R//) {
+ if (!have_cgi) {
+ skip "Skipping test without CGI module";
+ next;
+ }
+ $decoded = $req;
+ my $q = encode_base64($decoded);
+ chomp $q;
+ $req = "GET /apache/http_strict/send_hdr.pl?$q HTTP/1.0\r\n\r\n";
+ }
+
+ if (defined $cond && not $cond) {
+ $req = escape($req);
+ print "# SKIPPING:\n# $req\n";
+ skip "Test prerequisites are not met";
+ next;
+ }
+
+ my $sock = Apache::TestRequest::vhost_socket($vhost);
+ if (!$sock) {
+ print "# failed to connect\n";
+ ok(0);
+ next;
+ }
+ $sock->print($req);
+ $sock->shutdown(1);
+ sleep(0.1);
+ $req = escape($req);
+ print "# SENDING:\n# $req\n";
+ print "# DECODED: " . escape($decoded) . "\n" if $decoded;
+
+ 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 "# expecting $expect, got ", $rc, "\n";
+ ok ($response->code == $expect);
+ }
+ elsif ($expect == 90) {
+ print "# expecting headerless HTTP/0.9 body, got response\n";
+ ok (1);
+ }
+ elsif ($expect) {
+ print "# expecting success, got ", $rc, "\n";
+ ok ($rc >= 200 && $rc < 400);
+ }
+ else {
+ print "# expecting error, got ", $rc, "\n";
+ ok ($rc >= 400);
+ }
+ }
+}
+
+if ($test_fold) {
+ my $resp;
+ my $foo;
+ $resp = GET("/fold");
+ $foo = $resp->header("Foo");
+ ok ($resp->code == 200);
+ ok (defined($foo) && $foo =~ /Bar Baz/);
+}
+
+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;
+}
diff --git a/debian/perl-framework/t/apache/if_sections.t b/debian/perl-framework/t/apache/if_sections.t
new file mode 100644
index 0000000..12d591a
--- /dev/null
+++ b/debian/perl-framework/t/apache/if_sections.t
@@ -0,0 +1,76 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+#
+# Test <If > section merging
+#
+
+plan tests => (have_min_apache_version('2.4.26') ? 23 : 11) * 2,
+ need need_lwp,
+ need_module('mod_headers'),
+ need_module('mod_proxy'),
+ need_module('mod_proxy_http'),
+ need_min_apache_version('2.3.8');
+
+
+sub do_test
+{
+ my $url = shift;
+ my $set = shift;
+ my $expect = shift;
+
+ $url = "/if_sec$url";
+
+ my @headers_to_set = split(/\s+/, $set);
+ my @headers = map { ("In-If$_" => 1) } @headers_to_set;
+
+ my $response = GET($url, @headers);
+ print "# $url with '$set':\n";
+ ok t_cmp($response->code, 200);
+ ok t_cmp($response->header("Out-Trace"), $expect);
+}
+
+do_test('/', '', undef);
+do_test('/foo.if_test', '', undef);
+do_test('/foo.if_test', '1', 'global1');
+
+if (have_min_apache_version('2.4.26')) {
+ do_test('/foo.if_test', '1 11', 'global1, nested11, nested113');
+ do_test('/foo.if_test', '1 11 111', 'global1, nested11, nested111');
+ do_test('/foo.if_test', '1 11 112', 'global1, nested11, nested112');
+}
+
+do_test('/foo.if_test', '1 2', 'global1, files2');
+do_test('/dir/foo.txt', '1 2', 'global1, dir1, dir2, dir_files1');
+do_test('/dir/', '1 2', 'global1, dir1, dir2');
+
+if (have_min_apache_version('2.4.26')) {
+ do_test('/dir/', '1 11', 'global1, dir1, nested11, nested113');
+ do_test('/dir/', '1 11 111', 'global1, dir1, nested11, nested111');
+ do_test('/dir/', '1 11 112', 'global1, dir1, nested11, nested112');
+}
+
+do_test('/loc/', '1 2', 'global1, loc1, loc2');
+do_test('/loc/foo.txt', '1 2', 'global1, loc1, loc2');
+
+if (have_min_apache_version('2.4.26')) {
+ do_test('/loc/', '1 11', 'global1, loc1, nested11, nested113');
+ do_test('/loc/', '1 11 111', 'global1, loc1, nested11, nested111');
+ do_test('/loc/', '1 11 112', 'global1, loc1, nested11, nested112');
+}
+
+do_test('/loc/foo.if_test', '1 2', 'global1, files2, loc1, loc2');
+
+if (have_min_apache_version('2.4.26')) {
+ do_test('/loc/foo.if_test', '1 2 11', 'global1, files2, loc1, loc2, nested11, nested113');
+ do_test('/loc/foo.if_test', '1 2 11 111', 'global1, files2, loc1, loc2, nested11, nested111');
+ do_test('/loc/foo.if_test', '1 2 11 112', 'global1, files2, loc1, loc2, nested11, nested112');
+}
+
+do_test('/proxy/', '1 2', 'global1, locp1, locp2');
+do_test('/proxy/', '2', 'locp2');
+
diff --git a/debian/perl-framework/t/apache/iffile.t b/debian/perl-framework/t/apache/iffile.t
new file mode 100644
index 0000000..fab15a1
--- /dev/null
+++ b/debian/perl-framework/t/apache/iffile.t
@@ -0,0 +1,17 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+# Available since 2.4.34, but quoted paths in <IfFile> fixed in 2.4.35
+plan tests => 2,
+ need(
+ need_module('mod_headers'),
+ need_min_apache_version('2.4.35')
+ );
+
+my $resp = GET('/apache/iffile/document');
+ok t_cmp($resp->code, 200);
+ok t_cmp($resp->header('X-Out'), "success1, success2, success3, success4, success5");
diff --git a/debian/perl-framework/t/apache/leaks.t b/debian/perl-framework/t/apache/leaks.t
new file mode 100644
index 0000000..bb7b329
--- /dev/null
+++ b/debian/perl-framework/t/apache/leaks.t
@@ -0,0 +1,63 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+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,
+ 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 $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) {
+ my $r = GET $url;
+
+ print "# iter $_\n";
+
+ ok t_cmp($r->code, 200, "got response");
+
+ my $content = $r->content;
+ chomp $content;
+ my ($key, $id, $bytes) = split ',', $content;
+
+ 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;
+ }
+}
+
diff --git a/debian/perl-framework/t/apache/limits.t b/debian/perl-framework/t/apache/limits.t
new file mode 100644
index 0000000..a475f82
--- /dev/null
+++ b/debian/perl-framework/t/apache/limits.t
@@ -0,0 +1,217 @@
+#
+# 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 @limitrequestline@
+# LimitRequestFieldSize 1024
+# LimitRequestFields 32
+# <Directory @SERVERROOT@/htdocs/apache/limits>
+# LimitRequestBody 65536
+# </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 $limitrequestlinex2)),
+ '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";
+}
diff --git a/debian/perl-framework/t/apache/loglevel.t b/debian/perl-framework/t/apache/loglevel.t
new file mode 100644
index 0000000..cb542d1
--- /dev/null
+++ b/debian/perl-framework/t/apache/loglevel.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw/t_start_error_log_watch t_finish_error_log_watch/;
+
+plan tests => 8, need_min_apache_version('2.3.6');
+
+my $base = "/apache/loglevel";
+
+t_start_error_log_watch();
+
+my @error_expected =qw{
+ core_info
+ info
+ crit/core_info
+ info/core_crit/info
+};
+my @error_not_expected =qw{
+ core_crit
+ crit
+ info/core_crit
+ crit/core_info/crit
+};
+
+my $dir;
+foreach $dir (@error_expected) {
+ GET "$base/$dir/not_found_error_expected";
+}
+foreach $dir (@error_not_expected) {
+ GET "$base/$dir/not_found_error_NOT_expected";
+}
+
+my @loglines = t_finish_error_log_watch();
+my $log = join("\n", @loglines);
+
+foreach $dir (@error_expected) {
+ ok($log =~ m{does not exist.*?$base/$dir/not_found_error_expected});
+}
+foreach $dir (@error_not_expected) {
+ ok($log !~ m{does not exist.*?$base/$dir/not_found_error_NOT_expected});
+}
diff --git a/debian/perl-framework/t/apache/maxranges.t b/debian/perl-framework/t/apache/maxranges.t
new file mode 100644
index 0000000..015a474
--- /dev/null
+++ b/debian/perl-framework/t/apache/maxranges.t
@@ -0,0 +1,70 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_write_file);
+
+# test multi-byterange-requests with overlaps (merges)
+
+my $url = "/apache/chunked/byteranges.txt";
+my $file = Apache::Test::vars('serverroot') . "/htdocs$url";
+
+my $content = "";
+$content .= sprintf("%04d", $_) for (1 .. 2000);
+t_write_file($file, $content);
+my $clen = length($content);
+
+
+my $medrange = "";
+my $longrange = "";
+my $i;
+
+for (0 .. 50) {
+ $longrange .= "0-1,3-4,0-1,3-4,";
+ if ($_ % 2) {
+ $medrange .= "0-1,3-4,0-1,3-4,";
+ }
+}
+
+my @test_cases = (
+ { url => "/maxranges/default/byteranges.txt" , h => "0-100", status => "206"},
+ { url => "/maxranges/default/byteranges.txt" , h => $medrange, status => "206"},
+ { url => "/maxranges/default/byteranges.txt" , h => $longrange, status => "200"},
+
+ { url => "/maxranges/default-explicit/byteranges.txt" , h => "0-100", status => "206"},
+ { url => "/maxranges/default-explicit/byteranges.txt" , h => $medrange, status => "206"},
+ { url => "/maxranges/default-explicit/byteranges.txt" , h => $longrange, status => "200"},
+
+ { url => "/maxranges/none/byteranges.txt" , h => "0-100", status => "200"},
+ { url => "/maxranges/none/byteranges.txt" , h => "$medrange", status => "200"},
+ { url => "/maxranges/none/byteranges.txt" , h => "$longrange", status => "200"},
+
+ { url => "/maxranges/1/merge/none/byteranges.txt" , h => "0-100", status => "200"},
+ { url => "/maxranges/1/merge/none/byteranges.txt" , h => "$medrange", status => "200"},
+ { url => "/maxranges/1/merge/none/byteranges.txt" , h => "$longrange", status => "200"},
+
+ { url => "/maxranges/1/byteranges.txt" , h => "0-100", status => "206"},
+ { url => "/maxranges/1/byteranges.txt" , h => "0-100,200-300", status => "200"},
+ { url => "/maxranges/2/byteranges.txt" , h => "0-100,200-300", status => "206"},
+ { url => "/maxranges/2/byteranges.txt" , h => "0-100,200-300,400-500", status => "200"},
+ { url => "/maxranges/unlimited/byteranges.txt" , h => "0-100", status => "206"},
+ { url => "/maxranges/unlimited/byteranges.txt" , h => "$medrange", status => "206"},
+ { url => "/maxranges/unlimited/byteranges.txt" , h => "$longrange", status => "206"},
+
+);
+plan tests => scalar(@test_cases), need need_lwp, need_min_apache_version('2.3.15') || need_min_apache_version('2.2.21'),
+ need_module('mod_alias');
+
+
+foreach my $test (@test_cases) {
+ my $result = GET $test->{"url"}, "Range" => "bytes=" . $test->{"h"} ;
+ my $boundary;
+ my $ctype = $result->header("Content-Type");
+ if ($test->{"status"} ne $result->code()) {
+ print "Wrong status code: " . $result->code() ."\n";
+ ok(0);
+ next;
+ }
+ ok (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/mmn.t b/debian/perl-framework/t/apache/mmn.t
new file mode 100644
index 0000000..985a8e6
--- /dev/null
+++ b/debian/perl-framework/t/apache/mmn.t
@@ -0,0 +1,42 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+
+#
+# check that the comment and the #define in ap_mmn.h are equal
+#
+
+plan tests => 2, need_apache 2;
+
+my $config = Apache::TestConfig->thaw();
+my $filename = $config->apxs('INCLUDEDIR') . '/ap_mmn.h';
+
+my $cmajor;
+my $cminor;
+my $major;
+my $minor;
+my $skip;
+if (open(my $fh, "<", $filename)) {
+ while (defined (my $line = <$fh>)) {
+ if ($line =~ m/^\s+[*]\s+(\d{8})[.](\d+)\s+\([\d.]+(?:-dev)?\)\s/ ) {
+ $cmajor = $1;
+ $cminor = $2;
+ }
+ elsif ($line =~ m{^#define\s+MODULE_MAGIC_NUMBER_MAJOR\s+(\d+)(?:\s|$)})
+ {
+ $major = $1;
+ }
+ elsif ($line =~ m{^#define\s+MODULE_MAGIC_NUMBER_MINOR\s+(\d+)(?:\s|$)})
+ {
+ $minor = $1;
+ }
+ }
+ close($fh);
+}
+else {
+ $skip = "Skip if can't read $filename";
+}
+
+skip($skip, $major, $cmajor);
+skip($skip, $minor, $cminor);
diff --git a/debian/perl-framework/t/apache/options.t b/debian/perl-framework/t/apache/options.t
new file mode 100644
index 0000000..93809b7
--- /dev/null
+++ b/debian/perl-framework/t/apache/options.t
@@ -0,0 +1,17 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+my @urls = qw(/);
+
+plan tests => @urls * 2, \&need_lwp;
+
+for my $url (@urls) {
+ my $res = OPTIONS $url;
+ ok t_cmp $res->code, 200, "code";
+ my $allow = $res->header('Allow') || '';
+ ok t_cmp $allow, qr/OPTIONS/, "OPTIONS";
+}
diff --git a/debian/perl-framework/t/apache/passbrigade.t b/debian/perl-framework/t/apache/passbrigade.t
new file mode 100644
index 0000000..a31f29f
--- /dev/null
+++ b/debian/perl-framework/t/apache/passbrigade.t
@@ -0,0 +1,7 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestCommon ();
+
+Apache::TestCommon::run_write_test('test_pass_brigade');
+
diff --git a/debian/perl-framework/t/apache/post.t b/debian/perl-framework/t/apache/post.t
new file mode 100644
index 0000000..8c58847
--- /dev/null
+++ b/debian/perl-framework/t/apache/post.t
@@ -0,0 +1,12 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestCommon ();
+
+my $module = 'eat_post';
+my $num = Apache::TestCommon::run_post_test_sizes();
+
+plan tests => $num, need need_lwp, need_module($module);
+
+Apache::TestCommon::run_post_test($module);
diff --git a/debian/perl-framework/t/apache/pr17629.t b/debian/perl-framework/t/apache/pr17629.t
new file mode 100644
index 0000000..a089e98
--- /dev/null
+++ b/debian/perl-framework/t/apache/pr17629.t
@@ -0,0 +1,51 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+plan tests => 4, need [need_cgi, qw(include deflate case_filter)];
+my $inflator = "/modules/deflate/echo_post";
+
+my @deflate_headers;
+push @deflate_headers, "Accept-Encoding" => "gzip";
+
+my @inflate_headers;
+push @inflate_headers, "Content-Encoding" => "gzip";
+
+# The SSI script has the DEFLATE filter applied.
+# The SSI includes a CGI script.
+# The CGI script has the CASE filter applied.
+# The CGI script returns a redirect to /foobar.html.
+# The flat file does not have the DEFLATE filter applied.
+
+# The test is that the internal redirect when applied to the
+# subrequest must retain the DEFLATE filter in the filter chain, but
+# must lose the CASE filter.
+
+my $uri = "/modules/deflate/ssi/ssi.shtml";
+
+my $content = GET_BODY($uri);
+
+my $expected = "begin-foobar-end\n";
+
+ok t_cmp($content, $expected);
+
+my $r = GET($uri, @deflate_headers);
+
+ok t_cmp($r->code, 200);
+
+my $renc = $r->header("Content-Encoding") || "";
+
+ok t_cmp($renc, "gzip", "response was gzipped");
+
+if ($renc eq "gzip") {
+ my $deflated = POST_BODY($inflator, @inflate_headers,
+ content => $r->content);
+
+ ok t_cmp($deflated, $expected);
+}
+else {
+ skip "response not gzipped";
+}
diff --git a/debian/perl-framework/t/apache/pr18757.t b/debian/perl-framework/t/apache/pr18757.t
new file mode 100644
index 0000000..d53262f
--- /dev/null
+++ b/debian/perl-framework/t/apache/pr18757.t
@@ -0,0 +1,58 @@
+#
+# Regression test for PR 18757.
+#
+# Annoyingly awkward to write because LWP is a poor excuse for an HTTP
+# interface and will lie about what response headers are sent, so this
+# must be yet another test which speaks TCP directly.
+#
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+plan tests => 3, need 'proxy', need_min_apache_version('2.2.1'), need_cgi;
+
+Apache::TestRequest::module("mod_proxy");
+
+my $path = "/index.html";
+
+my $r = GET($path);
+
+ok t_cmp($r->code, 200, "200 response from GET");
+
+my $clength = $r->content_length;
+
+t_debug("expected C-L is $clength");
+
+my $url = Apache::TestRequest::resolve_url($path);
+my $hostport = Apache::TestRequest::hostport();
+my $sock = Apache::TestRequest::vhost_socket("mod_proxy");
+
+t_debug "URL via proxy is $url";
+
+ok $sock;
+
+$sock->print("HEAD $url HTTP/1.1\r\n");
+$sock->print("Host: $hostport\r\n");
+$sock->print("\r\n");
+
+my $ok = 0;
+my $response;
+
+do {
+ chomp($response = Apache::TestRequest::getline($sock) || '');
+ $response =~ s/\s$//;
+
+ t_debug("line: $response");
+
+ if ($response =~ /Content-Length: $clength/) {
+ $ok = 1;
+ }
+
+}
+while ($response ne "");
+
+ok t_cmp($ok, 1, "whether proxy strips Content-Length header");
diff --git a/debian/perl-framework/t/apache/pr35292.t b/debian/perl-framework/t/apache/pr35292.t
new file mode 100644
index 0000000..9a6243e
--- /dev/null
+++ b/debian/perl-framework/t/apache/pr35292.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+$SIG{PIPE} = 'IGNORE';
+
+plan tests => 3, need_min_apache_version('2.1.8');
+
+my $sock = Apache::TestRequest::vhost_socket('default');
+ok $sock;
+
+Apache::TestRequest::socket_trace($sock);
+
+$sock->print("POST /apache/limits/ HTTP/1.1\r\n");
+$sock->print("Host: localhost\r\n");
+$sock->print("Content-Length: 1048576\r\n");
+$sock->print("\r\n");
+
+foreach (1..128) {
+ $sock->print('x'x8192) if $sock->connected;
+}
+
+# Before the PR 35292 fix, the socket would already have been reset by
+# this point and most clients will have stopped sending and gone away.
+
+ok $sock->connected;
+
+my $line = Apache::TestRequest::getline($sock) || '';
+
+ok t_cmp($line, qr{^HTTP/1\.. 413}, "read response-line");
diff --git a/debian/perl-framework/t/apache/pr35330.t b/debian/perl-framework/t/apache/pr35330.t
new file mode 100644
index 0000000..e5fe01f
--- /dev/null
+++ b/debian/perl-framework/t/apache/pr35330.t
@@ -0,0 +1,16 @@
+#
+# Regression test for PR 35330
+#
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+plan tests => 2, need 'include';
+
+my $r = GET '/apache/htaccess/override/hello.shtml';
+
+ok t_cmp($r->code, 200, "SSI was allowed for location");
+ok t_cmp($r->content, "hello", "file was served with correct content");
diff --git a/debian/perl-framework/t/apache/pr37166.t b/debian/perl-framework/t/apache/pr37166.t
new file mode 100644
index 0000000..919cda2
--- /dev/null
+++ b/debian/perl-framework/t/apache/pr37166.t
@@ -0,0 +1,29 @@
+#
+# Regression test for PR 37166
+#
+# r370692 determined that a CGI script which outputs an explicit
+# "Status: 200" will not be subject to conditional request processing.
+# Previous behaviour was the opposite, but fell foul of the r->status
+# vs r->status_line issue fixed in r385581.
+#
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+plan tests => 4, \&need_cgi;
+
+my $uri = '/modules/cgi/pr37166.pl';
+
+my $r = GET $uri;
+
+ok t_cmp($r->code, 200, "SSI was allowed for location");
+ok t_cmp($r->content, "Hello world\n", "file was served with correct content");
+
+$r = GET $uri, "If-Modified-Since" => "Tue, 15 Feb 2005 15:00:00 GMT";
+
+ok t_cmp($r->code, 200, "explicit 200 response");
+ok t_cmp($r->content, "Hello world\n",
+ "file was again served with correct content");
diff --git a/debian/perl-framework/t/apache/pr43939.t b/debian/perl-framework/t/apache/pr43939.t
new file mode 100644
index 0000000..5e35f9e
--- /dev/null
+++ b/debian/perl-framework/t/apache/pr43939.t
@@ -0,0 +1,47 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+plan tests => 4, need [need_cgi, qw(include deflate case_filter)];
+my $inflator = "/modules/deflate/echo_post";
+
+my @deflate_headers;
+push @deflate_headers, "Accept-Encoding" => "gzip";
+
+my @inflate_headers;
+push @inflate_headers, "Content-Encoding" => "gzip";
+
+# The SSI script has the DEFLATE filter applied.
+# The SSI includes directory index page.
+# The directory index page is processed with a fast internal redirect.
+
+# The test is that filter chain survives across the redirect.
+
+my $uri = "/modules/deflate/ssi/ssi2.shtml";
+
+my $content = GET_BODY($uri);
+
+my $expected = "begin-default-end\n";
+
+ok t_cmp($content, $expected);
+
+my $r = GET($uri, @deflate_headers);
+
+ok t_cmp($r->code, 200);
+
+my $renc = $r->header("Content-Encoding") || "";
+
+ok t_cmp($renc, "gzip", "response was gzipped");
+
+if ($renc eq "gzip") {
+ my $deflated = POST_BODY($inflator, @inflate_headers,
+ content => $r->content);
+
+ ok t_cmp($deflated, $expected);
+}
+else {
+ skip "response not gzipped";
+}
diff --git a/debian/perl-framework/t/apache/pr49328.t b/debian/perl-framework/t/apache/pr49328.t
new file mode 100644
index 0000000..5b37032
--- /dev/null
+++ b/debian/perl-framework/t/apache/pr49328.t
@@ -0,0 +1,25 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+plan tests => 1, need [qw(filter include deflate)];
+
+my $inflator = "/modules/deflate/echo_post";
+
+my @deflate_headers;
+push @deflate_headers, "Accept-Encoding" => "gzip";
+
+my @inflate_headers;
+push @inflate_headers, "Content-Encoding" => "gzip";
+
+my $uri = "/modules/filter/pr49328/pr49328.shtml";
+
+my $content = GET_BODY($uri, @deflate_headers);
+
+my $deflated = POST_BODY($inflator, @inflate_headers,
+ content => $content);
+
+ok t_cmp($deflated, "before\nincluded\nafter\n");
diff --git a/debian/perl-framework/t/apache/rwrite.t b/debian/perl-framework/t/apache/rwrite.t
new file mode 100644
index 0000000..e27808c
--- /dev/null
+++ b/debian/perl-framework/t/apache/rwrite.t
@@ -0,0 +1,6 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestCommon ();
+
+Apache::TestCommon::run_write_test('test_rwrite');
diff --git a/debian/perl-framework/t/apache/server_name_port.t b/debian/perl-framework/t/apache/server_name_port.t
new file mode 100644
index 0000000..2597d7c
--- /dev/null
+++ b/debian/perl-framework/t/apache/server_name_port.t
@@ -0,0 +1,135 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Socket;
+
+# send
+# arg #1: url prefix
+# arg #2: Host header (none if undef)
+# expected results:
+# arg #3: response code
+# arg #4: SERVER_NAME
+# arg #5: SERVER_PORT (canonical port if 'REMOTE')
+# undef == don't care
+
+my $url_suffix = 'modules/cgi/env.pl';
+
+my @test_cases = (
+ [ "/", "righthost" => 200, 'righthost', 'REMOTE' ],
+ [ "/", "righthost:123" => 200, 'righthost', '123' ],
+ [ "/", "Righthost" => 200, 'righthost', 'REMOTE' ],
+ [ "/", "Righthost:123" => 200, 'righthost', '123' ],
+ [ "/", "128.0.0.1" => 200, '128.0.0.1', 'REMOTE' ],
+ [ "/", "128.0.0.1:123" => 200, '128.0.0.1', '123' ],
+ [ "/", "[::1]" => 200, '[::1]', 'REMOTE' ],
+ [ "/", "[::1]:123" => 200, '[::1]', '123' ],
+ [ "/", "[a::1]" => 200, '[a::1]', 'REMOTE' ],
+ [ "/", "[a::1]:123" => 200, '[a::1]', '123' ],
+ [ "/", "[A::1]" => 200, '[a::1]', 'REMOTE' ],
+ [ "/", "[A::1]:123" => 200, '[a::1]', '123' ],
+ [ "http://righthost/", undef => 200, 'righthost', 'REMOTE' ],
+ [ "http://righthost:123/", undef => 200, 'righthost', '123' ],
+ [ "http://Righthost/", undef => 200, 'righthost', 'REMOTE' ],
+ [ "http://Righthost:123/", undef => 200, 'righthost', '123' ],
+ [ "http://128.0.0.1/", undef => 200, '128.0.0.1', 'REMOTE' ],
+ [ "http://128.0.0.1:123/", undef => 200, '128.0.0.1', '123' ],
+ [ "http://[::1]/", undef => 200, '[::1]', 'REMOTE' ],
+ [ "http://[::1]:123/", undef => 200, '[::1]', '123' ],
+ [ "http://righthost/", "wronghost" => 200, 'righthost', 'REMOTE' ],
+ [ "http://righthost:123/", "wronghost:321" => 200, 'righthost', '123' ],
+ [ "http://Righthost/", "wronghost" => 200, 'righthost', 'REMOTE' ],
+ [ "http://Righthost:123/", "wronghost:321" => 200, 'righthost', '123' ],
+ [ "http://128.0.0.1/", "126.0.0.1" => 200, '128.0.0.1', 'REMOTE' ],
+ [ "http://128.0.0.1:123/", "126.0.0.1:321" => 200, '128.0.0.1', '123' ],
+ [ "http://[::1]/", "[::2]" => 200, '[::1]', 'REMOTE' ],
+ [ "http://[::1]:123/", "[::2]:321" => 200, '[::1]', '123' ],
+);
+
+my @todo;
+if (!have_min_apache_version('2.4.24')) {
+ # r1426827
+ push @todo, 32, 35, 56, 59, 80, 83;
+}
+if (!have_min_apache_version('2.4')) {
+ # r1147614, PR 26005
+ push @todo, 20, 23, 26, 29;
+}
+
+plan tests => 3 * scalar(@test_cases), todo => \@todo, need need_min_apache_version('2.2'), need_cgi;
+
+foreach my $t (@test_cases) {
+ my $req = "GET $t->[0]$url_suffix HTTP/1.1\r\nConnection: close\r\n";
+ $req .= "Host: $t->[1]\r\n" if defined $t->[1];
+ $req .= "\r\n";
+
+ my %ex = (
+ rc => $t->[2],
+ SERVER_NAME => $t->[3],
+ SERVER_PORT => $t->[4],
+ );
+
+ my $sock = Apache::TestRequest::vhost_socket();
+ if (!$sock) {
+ print "# failed to connect\n";
+ ok(0);
+ next;
+ }
+ if (defined $ex{SERVER_PORT} && $ex{SERVER_PORT} eq 'REMOTE') {
+ my $peername = getpeername($sock);
+ my ($port) = sockaddr_in($peername);
+ $ex{SERVER_PORT} = "$port";
+ }
+
+ $sock->print($req);
+ $sock->shutdown(1);
+ sleep(0.1);
+ print "# SENDING:\n# ", escape($req), "\n";
+
+ my $response_data = "";
+ my $buf;
+ while ($sock->read($buf, 10000) > 0) {
+ $response_data .= $buf;
+ }
+ my $response = HTTP::Response->parse($response_data);
+ if (! defined $response) {
+ die "HTTP::Response->parse failed";
+ }
+ my $rc = $response->code;
+ if (! defined $rc) {
+ print "# HTTPD dropped the connection\n";
+ ok(0);
+ }
+ else {
+ print "# expecting $ex{rc}, got ", $rc, "\n";
+ ok ($rc == $ex{rc});
+ }
+
+ foreach my $var (qw/SERVER_NAME SERVER_PORT/) {
+ if (! defined $ex{$var}) {
+ print "# don't care about $var\n";
+ ok(1);
+ }
+ elsif ($response_data =~ /^$var = (.*)$/m) {
+ my $val = $1;
+ print "# got $var='$val', expected '$ex{$var}'\n";
+ ok($val eq $ex{$var});
+ }
+ else {
+ print "# no $var in response, expected '$ex{$var}'\n";
+ ok(0);
+ }
+ }
+}
+
+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;
+}
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");