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
|
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestRequest;
use Apache::TestUtil qw(t_write_file);
Apache::TestRequest::user_agent(keep_alive => 1);
my $debug = 0;
my $url = '/modules/substitue/test.txt';
# mod_bucketeer control chars
my $B = chr(0x02);
my $F = chr(0x06);
my $P = chr(0x10);
my @test_cases = (
[ "f${B}o${P}ofoo" => 's/foo/bar/' ],
[ "f${B}o${P}ofoo" => 's/fo/fa/', 's/fao/bar/' ],
[ "foofoo" => 's/Foo/bar/' ],
[ "fo${F}ofoo" => 's/Foo/bar/i' ],
[ "foOFoo" => 's/OF/of/', 's/foo/bar/' ],
[ "fofooo" => 's/(.)fo/$1of/', 's/foo/bar/' ],
[ "foof\noo" => 's/f.oo/bar/' ],
[ "xfooo" => 's/foo/fo/' ],
[ "xfoo" x 4000 => 's/foo/bar/', 's/FOO/BAR/' ],
[ "foox\n" x 4000 => 's/foo/bar/', 's/FOO/BAR/' ],
[ "a.baxb(" => 's/a.b/a$1/n' ],
[ "a.baxb(" => 's/a.b/a$1/n', 's/1axb(/XX/n' ],
[ "xfoo" x 4000 => 's/foo/bar/n', 's/FOO/BAR/n' ],
);
if (have_min_apache_version("2.3.5")) {
# tests for r1307067
push @test_cases, [ "x<body>x" => 's/<body>/&/' ],
[ "x<body>x" => 's/<body>/$0/' ],
[ "foobar" => 's/(oo)b/c$1/' ],
[ "foobar" => 's/(oo)b/c\$1/' ],
[ "foobar" => 's/(oo)b/\d$1/' ];
}
plan tests => scalar @test_cases,
need need_lwp,
need_module('mod_substitute'),
need_module('mod_bucketeer');
foreach my $t (@test_cases) {
my ($content, @rules) = @{$t};
write_testfile($content);
write_htaccess(@rules);
# We assume that perl does the right thing (TM) and compare that with
# mod_substitute's result.
my $expect = $content;
$expect =~ s/[$B$F$P]+//g;
foreach my $rule (@rules) {
if ($rule =~ s/n$//) {
# non-regex match, escape specials for perl
my @parts = split('/', $rule);
$parts[1] = quotemeta($parts[1]);
$parts[2] = quotemeta($parts[2]);
$rule = join('/', @parts);
$rule .= '/' if (scalar @parts == 3);
}
else {
# special case: HTTPD uses $0 for the whole match, perl uses $&
$rule =~ s/\$0/\$&/g;
}
$rule .= "g"; # mod_substitute always does global search & replace
# "no warnings" because the '\d' in one of the rules causes a warning,
# which we have set to be fatal.
eval "{\n no warnings ; \$expect =~ $rule\n}";
}
my $response = GET('/modules/substitute/test.txt');
my $rc = $response->code;
my $got = $response->content;
my $ok = ($rc == 200) && ($got eq $expect);
print "got $rc '$got'", ($ok ? ": OK\n" : ", expected '$expect'\n");
ok($ok);
}
exit 0;
### sub routines
sub write_htaccess
{
my @rules = @_;
my $file = File::Spec->catfile(Apache::Test::vars('serverroot'), 'htdocs',
'modules', 'substitute', '.htaccess');
my $content = "SetOutputFilter BUCKETEER;SUBSTITUTE\n";
$content .= "Substitute $_\n" for @rules;
t_write_file($file, $content);
print "$content<===\n" if $debug;
}
sub write_testfile
{
my $content = shift;
my $file = File::Spec->catfile(Apache::Test::vars('serverroot'), 'htdocs',
'modules', 'substitute', 'test.txt');
t_write_file($file, $content);
print "$content<===\n" if $debug;
}
|
