diff options
Diffstat (limited to 'debian/perl-framework/t/modules/headers.t')
| -rw-r--r-- | debian/perl-framework/t/modules/headers.t | 311 |
1 files changed, 311 insertions, 0 deletions
diff --git a/debian/perl-framework/t/modules/headers.t b/debian/perl-framework/t/modules/headers.t new file mode 100644 index 0000000..c72c690 --- /dev/null +++ b/debian/perl-framework/t/modules/headers.t @@ -0,0 +1,311 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestUtil; +use Apache::TestRequest; + +## +## mod_headers tests +## + +my $htdocs = Apache::Test::vars('documentroot'); +my $htaccess = "$htdocs/modules/headers/htaccess/.htaccess"; +my @header_types = ('set', 'append', 'add', 'unset'); + +my @testcases = ( + ## htaccess + ## Header to set in the request + ## Expected result + + # echo + [ + "Header echo Test-Header\nHeader echo ^Aaa\$\nHeader echo ^Aa\$", + [ 'Test-Header' => 'value', 'Aaa' => 'b' , 'Aa' => 'bb' ], + [ 'Test-Header' => 'value', 'Aaa' => 'b' , 'Aa' => 'bb' ], + ], + [ + "Header echo Test-Header\nHeader echo XXX\nHeader echo ^Aa\$", + [ 'Test-Header' => 'foo', 'aaa' => 'b', 'aa' => 'bb' ], + [ 'Test-Header' => 'foo', 'aa' => 'bb' ], + ], + [ + "Header echo Test-Header.*", # regex + [ 'Test-Header' => 'foo', 'Test-Header1' => 'value1', 'Test-Header2' => 'value2' ], + [ 'Test-Header' => 'foo', 'Test-Header1' => 'value1', 'Test-Header2' => 'value2' ], + ], + # edit + [ + "Header echo Test-Header\nHeader edit Test-Header foo bar", # sizeof(foo) = sizeof(bar) + [ 'Test-Header' => 'foofoo' ], + [ 'Test-Header' => 'barfoo' ], + ], + [ + "Header echo Test-Header\nHeader edit Test-Header foo2 bar", # sizeof(foo2) > sizeof(bar) + [ 'Test-Header' => 'foo2foo2' ], + [ 'Test-Header' => 'barfoo2' ], + ], + [ + "Header echo Test-Header\nHeader edit Test-Header foo bar2", # sizeof(foo) < sizeof(bar2) + [ 'Test-Header' => 'foofoo' ], + [ 'Test-Header' => 'bar2foo' ], + ], + # edit* + [ + "Header echo Test-Header\nHeader edit* Test-Header foo bar", # sizeof(foo) = sizeof(bar) + [ 'Test-Header' => 'foofoo' ], + [ 'Test-Header' => 'barbar' ], + ], + [ + "Header echo Test-Header\nHeader edit* Test-Header foo2 bar", # sizeof(foo2) > sizeof(bar) + [ 'Test-Header' => 'foo2foo2' ], + [ 'Test-Header' => 'barbar' ], + ], + [ + "Header echo Test-Header\nHeader edit* Test-Header foo bar2", # sizeof(foo) < sizeof(bar2) + [ 'Test-Header' => 'foofoo' ], + [ 'Test-Header' => 'bar2bar2' ], + ], + # merge + [ + "Header merge Test-Header foo", # missing header + [ ], + [ 'Test-Header' => 'foo' ], + ], + [ + "Header echo Test-Header\nHeader merge Test-Header foo", # already existing, same value + [ 'Test-Header' => 'foo' ], + [ 'Test-Header' => 'foo' ], + ], + [ + "Header echo Test-Header\nHeader merge Test-Header foo", # already existing, same value, but with "" + [ 'Test-Header' => '"foo"' ], + [ 'Test-Header' => '"foo", foo' ], + ], + [ + "Header echo Test-Header\nHeader merge Test-Header bar", # already existing, different value + [ 'Test-Header' => 'foo' ], + [ 'Test-Header' => 'foo, bar' ], + ], + # setifempty + [ + "Header echo Test-Header\nHeader setifempty Test-Header bar", # already existing + [ 'Test-Header' => 'foo' ], + [ 'Test-Header' => 'foo' ], + ], + [ + "Header echo Test-Header\nHeader setifempty Test-Header2 bar", # missing header + [ 'Test-Header' => 'foo' ], + [ 'Test-Header' => 'foo', 'Test-Header2' => 'bar' ], + ], + # env= + [ + "SetEnv MY_ENV\nHeader set Test-Header foo env=MY_ENV", # env defined + [ ], + [ 'Test-Header' => 'foo' ], + ], + [ + "Header set Test-Header foo env=!MY_ENV", # env NOT defined + [ ], + [ 'Test-Header' => 'foo' ], + ], + # expr= + [ + "Header set Test-Header foo \"expr=%{REQUEST_URI} =~ m#htaccess#\"", # expr + [ ], + [ 'Test-Header' => 'foo' ], + ], +); + +plan tests => + @header_types**4 + @header_types**3 + @header_types**2 + @header_types**1 + scalar @testcases * 2, + have_module 'headers'; + +# Test various configurations +foreach my $header1 (@header_types) { + + ok test_header($header1); + foreach my $header2 (@header_types) { + + ok test_header($header1, $header2); + foreach my $header3 (@header_types) { + + ok test_header($header1, $header2, $header3); + foreach my $header4 (@header_types) { + + ok test_header($header1, $header2, $header3, $header4); + + } + + } + + } + +} + +# Test some other Header directives, including regex +my $ua = LWP::UserAgent->new(); +my $hostport = Apache::TestRequest::hostport(); +foreach my $t (@testcases) { + test_header2($t); +} + +## clean up ## +unlink $htaccess; + +sub test_header { + my @h = @_; + my $test_header = "Test-Header"; + my (@expected_value, @actual_value) = ((),()); + my ($expected_exists, $expected_value, $actual_exists) = (0,0,0); + + open (HT, ">$htaccess"); + foreach (@h) { + + ## create a unique header value ## + my $r = int(rand(9999)); + my $test_value = "mod_headers test header value $r"; + + ## evaluate $_ to come up with expected results + ## and write out the .htaccess file + if ($_ eq 'unset') { + print HT "Header $_ $test_header\n"; + @expected_value = (); + $expected_exists = 0; + $expected_value = 0; + } else { + print HT "Header $_ $test_header \"$test_value\"\n"; + + if ($_ eq 'set') { + + ## should 'set' work this way? + ## currently, even if there are multiple headers + ## with the same name, 'set' blows them all away + ## and sets a single one with this value. + @expected_value = (); + $expected_exists = 1; + + $expected_value = $test_value; + } elsif ($_ eq 'append') { + + ## should 'append' work this way? + ## currently, if there are multiple headers + ## with the same name, 'append' appends the value + ## to the FIRST instance of that header. + if (@expected_value) { + $expected_value[0] .= ", $test_value"; + + } elsif ($expected_value) { + $expected_value .= ", $test_value"; + } else { + $expected_value = $test_value; + } + $expected_exists++ unless $expected_exists; + + } elsif ($_ eq 'add') { + if ($expected_value) { + push(@expected_value, $expected_value); + $expected_value = 0; + } + $expected_value = $test_value; + $expected_exists++; + } + } + } + close(HT); + + push(@expected_value, $expected_value) if $expected_value; + + ## get the actual headers ## + my $h = HEAD_STR "/modules/headers/htaccess/"; + + ## parse response headers looking for our headers + ## and save the value(s) + my $exists = 0; + my $actual_value; + foreach my $head (split /\n/, $h) { + if ($head =~ /^$test_header: (.*)$/) { + $actual_exists++; + push(@actual_value, $1); + } + } + + ## ok if 'unset' and there are no headers ## + return 1 if ($actual_exists == 0 and $expected_exists == 0); + + if (($actual_exists == $expected_exists) && + (@actual_value == @expected_value)) { + + ## go through each actual header ## + foreach my $av (@actual_value) { + my $matched = 0; + + ## and each expected header ## + for (my $i = 0 ; $i <= @expected_value ; $i++) { + + if ($av eq $expected_value[$i]) { + + ## if we match actual and expected, + ## record it, and remove the header + ## from the expected list + $matched++; + splice(@expected_value, $i, 1); + last; + + } + } + + ## not ok if actual value does not match expected ## + return 0 unless $matched; + } + + ## if we made it this far, all is well. ## + return 1; + + } else { + + ## not ok if the number of expected and actual + ## headers do not match + return 0; + + } +} + +sub test_header2 { + my @test = @_; + my $h = HTTP::Headers->new; + + print "\n\n\n"; + for (my $i = 0; $i < scalar @{$test[0][1]}; $i += 2) { + print "Header sent n°" . $i/2 . ":\n"; + print " header: " . $test[0][1][$i] . "\n"; + print " value: " . $test[0][1][$i+1] . "\n"; + $h->header($test[0][1][$i] => $test[0][1][$i+1]); + } + + open (HT, ">$htaccess"); + print HT $test[0][0]; + close(HT); + + ## + my $r = HTTP::Request->new('GET', "http://$hostport/modules/headers/htaccess/", $h); + my $res = $ua->request($r); + ok t_cmp($res->code, 200, "Checking return code is '200'"); + + my $isok = 1; + for (my $i = 0; $i < scalar @{$test[0][2]}; $i += 2) { + print "\n"; + print "Header received n°" . $i/2 . ":\n"; + print " header: " . $test[0][2][$i] . "\n"; + print " expected: " . $test[0][2][$i+1] . "\n"; + if ($res->header($test[0][2][$i])) { + print " received: " . $res->header($test[0][2][$i]) . "\n"; + } else { + print " received: <undefined>\n"; + } + $isok = $isok && $res->header($test[0][2][$i]) && $test[0][2][$i+1] eq $res->header($test[0][2][$i]); + } + print "\nResponse received is:\n" . $res->as_string; + + ok $isok; +} |