summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/apache/headers.t
blob: 2412effdae6e4fbb48f302d1a7e21d274305373a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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;
}