summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/apache/expr_string.t
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 15:01:31 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 15:01:31 +0000
commitc9cf025fadfe043f0f2f679e10d1207d8a158bb6 (patch)
tree3a94effe0bdc0a6814d8134f4ed840d7cc6b6f19 /debian/perl-framework/t/apache/expr_string.t
parentAdding upstream version 2.4.57. (diff)
downloadapache2-c9cf025fadfe043f0f2f679e10d1207d8a158bb6.tar.xz
apache2-c9cf025fadfe043f0f2f679e10d1207d8a158bb6.zip
Adding debian version 2.4.57-2.debian/2.4.57-2
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/perl-framework/t/apache/expr_string.t')
-rw-r--r--debian/perl-framework/t/apache/expr_string.t123
1 files changed, 123 insertions, 0 deletions
diff --git a/debian/perl-framework/t/apache/expr_string.t b/debian/perl-framework/t/apache/expr_string.t
new file mode 100644
index 0000000..4682d4a
--- /dev/null
+++ b/debian/perl-framework/t/apache/expr_string.t
@@ -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
+}