summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/modules/headers.t
blob: 3504a3357e605a5b46a2c436ce5e0516fed7c2d9 (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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
use strict;
use warnings FATAL => 'all';

use Apache::Test;
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');
    
plan tests => 
    @header_types**4 + @header_types**3 + @header_types**2 + @header_types**1,
    have_module 'headers';

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);

            }

        }

    }

}

## 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;

    }
}