Adding debian version 2.4.63-1.
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
This commit is contained in:
parent
7263481e48
commit
f56986e2d9
1490 changed files with 80785 additions and 0 deletions
123
debian/perl-framework/t/apache/expr_string.t
vendored
Normal file
123
debian/perl-framework/t/apache/expr_string.t
vendored
Normal file
|
@ -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
|
||||
}
|
Loading…
Add table
Add a link
Reference in a new issue