summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/apache/expr.t
diff options
context:
space:
mode:
Diffstat (limited to 'debian/perl-framework/t/apache/expr.t')
-rw-r--r--debian/perl-framework/t/apache/expr.t327
1 files changed, 327 insertions, 0 deletions
diff --git a/debian/perl-framework/t/apache/expr.t b/debian/perl-framework/t/apache/expr.t
new file mode 100644
index 0000000..7d62bc0
--- /dev/null
+++ b/debian/perl-framework/t/apache/expr.t
@@ -0,0 +1,327 @@
+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);
+
+use File::Spec;
+
+# test ap_expr
+
+Apache::TestRequest::user_agent(keep_alive => 1);
+
+my $file_foo = Apache::Test::vars('serverroot') . '/htdocs/expr/index.html';
+my $dir_foo = Apache::Test::vars('serverroot') . '/htdocs/expr';
+my $file_notexist = Apache::Test::vars('serverroot') . '/htdocs/expr/none';
+my $file_zero = Apache::Test::vars('serverroot') . '/htdocs/expr/zero';
+my $url_foo = '/apache/';
+my $url_notexist = '/apache/expr/none';
+my @test_cases = (
+ [ 'true' => 1 ],
+ [ 'false' => 0 ],
+ [ 'foo' => undef ],
+ # integer comparison
+ [ '1 -eq 01' => 1 ],
+ [ '1 -eq 2' => 0 ],
+ [ '1 -ne 2' => 1 ],
+ [ '1 -ne 1' => 0 ],
+ [ '1 -lt 02' => 1 ],
+ [ '1 -lt 1' => 0 ],
+ [ '1 -le 2' => 1 ],
+ [ '1 -le 1' => 1 ],
+ [ '2 -gt 1' => 1 ],
+ [ '1 -gt 1' => 0 ],
+ [ '2 -ge 1' => 1 ],
+ [ '1 -ge 1' => 1 ],
+ [ '1 -gt -1' => 1 ],
+ # string comparison
+ [ q{'aa' == 'aa'} => 1 ],
+ [ q{'aa' == 'b'} => 0 ],
+ [ q{'aa' = 'aa'} => 1 ],
+ [ q{'aa' = 'b'} => 0 ],
+ [ q{'aa' != 'b'} => 1 ],
+ [ q{'aa' != 'aa'} => 0 ],
+ [ q{'aa' < 'b'} => 1 ],
+ [ q{'aa' < 'aa'} => 0 ],
+ [ q{'aa' <= 'b'} => 1 ],
+ [ q{'aa' <= 'aa'} => 1 ],
+ [ q{'b' > 'aa'} => 1 ],
+ [ q{'aa' > 'aa'} => 0 ],
+ [ q{'b' >= 'aa'} => 1 ],
+ [ q{'aa' >= 'aa'} => 1 ],
+ # string operations/whitespace handling
+ [ q{'a' . 'b' . 'c' = 'abc'} => 1 ],
+ [ q{'a' .'b'. 'c' = 'abc'} => 1 ],
+ [ q{ 'a' .'b'. 'c'='abc' } => 1 ],
+ [ q{'a1c' = 'a'. 1. 'c'} => 1 ],
+ [ q{req('foo') . 'bar' = 'bar'} => 1 ],
+ [ q[%{req:foo} . 'bar' = 'bar'] => 1 ],
+ [ q['x'.%{req:foo} . 'bar' = 'xbar'] => 1 ],
+ [ q[%{req:User-Agent} . 'bar' != 'bar'] => 1 ],
+ [ q['%{req:User-Agent}' . 'bar' != 'bar'] => 1 ],
+ [ q['%{TIME}' . 'bar' != 'bar'] => 1 ],
+ [ q[%{TIME} != ''] => 1 ],
+ # string lists
+ [ q{'a' -in { 'b', 'a' } } => 1 ],
+ [ q{'a' -in { 'b', 'c' } } => 0 ],
+ # regexps
+ [ q[ 'abc' =~ /bc/ ] => 1 ],
+ [ q[ 'abc' =~ /BC/i ] => 1 ],
+ [ q[ 'abc' !~ m!bc! ] => 0 ],
+ [ q[ 'abc' !~ m!BC!i ] => 0 ],
+ [ q[ $0 == '' ] => 1 ],
+ [ q[ $1 == '' ] => 1 ],
+ [ q[ $9 == '' ] => 1 ],
+ [ q[ '$0' == '' ] => 1 ],
+ [ q[ 'abc' =~ /(bc)/ && $0 == 'bc' ] => 1 ],
+ [ q[ 'abc' =~ /(bc)/ && $1 == 'bc' ] => 1 ],
+ [ q[ 'abc' =~ /b(.)/ && $1 == 'c' ] => 1 ],
+ # $0 .. $9 are only populated if there are capturing parens
+ [ q[ 'abc' =~ /bc/ && $0 == '' ] => 1 ],
+ [ q[ 'abc' =~ /(bc)/ && 'xy' =~ /x/ && $0 == 'bc' ] => 1 ],
+ # Attempt to blow up when more matches are present than 'typical' $0 .. $9
+ [ q[ 'abcdefghijklm' =~ /(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)/ && $2 == 'c' ] => 1 ],
+ # variables
+ [ q[%{TIME_YEAR} =~ /^\d{4}$/] => 1 ],
+ [ q[%{TIME_YEAR} =~ /^\d{3}$/] => 0 ],
+ [ q[%{TIME_MON} -gt 0 && %{TIME_MON} -le 12 ] => 1 ],
+ [ q[%{TIME_DAY} -gt 0 && %{TIME_DAY} -le 31 ] => 1 ],
+ [ q[%{TIME_HOUR} -ge 0 && %{TIME_HOUR} -lt 24 ] => 1 ],
+ [ q[%{TIME_MIN} -ge 0 && %{TIME_MIN} -lt 60 ] => 1 ],
+ [ q[%{TIME_SEC} -ge 0 && %{TIME_SEC} -lt 60 ] => 1 ],
+ [ q[%{TIME} =~ /^\d{14}$/] => 1 ],
+ [ q[%{API_VERSION} -gt 20101001 ] => 1 ],
+ [ q[%{REQUEST_METHOD} == 'GET' ] => 1 ],
+ [ q['x%{REQUEST_METHOD}' == 'xGET' ] => 1 ],
+ [ q['x%{REQUEST_METHOD}y' == 'xGETy' ] => 1 ],
+ [ q[%{REQUEST_SCHEME} == 'http' ] => 1 ],
+ [ q[%{HTTPS} == 'off' ] => 1 ],
+ [ q[%{REQUEST_URI} == '/apache/expr/index.html' ] => 1 ],
+ # request headers
+ [ q[%{req:referer} = 'SomeReferer' ] => 1 ],
+ [ q[req('Referer') = 'SomeReferer' ] => 1 ],
+ [ q[http('Referer') = 'SomeReferer' ] => 1 ],
+ [ q[%{HTTP_REFERER} = 'SomeReferer' ] => 1 ],
+ [ q[req('User-Agent') = 'SomeAgent' ] => 1 ],
+ [ q[%{HTTP_USER_AGENT} = 'SomeAgent' ] => 1 ],
+ [ q[req('SomeHeader') = 'SomeValue' ] => 1 ],
+ [ q[req('SomeHeader2') = 'SomeValue' ] => 0 ],
+ # functions
+ [ q[toupper('abC12d') = 'ABC12D' ] => 1 ],
+ [ q[tolower('abC12d') = 'abc12d' ] => 1 ],
+ [ q[escape('?') = '%3f' ] => 1 ],
+ [ q[unescape('%3f') = '?' ] => 1 ],
+ [ q[toupper(escape('?')) = '%3F' ] => 1 ],
+ [ q[tolower(toupper(escape('?'))) = '%3f' ] => 1 ],
+ [ q[%{toupper:%{escape:?}} = '%3F' ] => 1 ],
+ [ q[file('] . $file_foo . q[') = 'foo\n' ] => 1 ],
+ # unary operators
+ [ q[-n ''] => 0 ],
+ [ q[-z ''] => 1 ],
+ [ q[-n '1'] => 1 ],
+ [ q[-z '1'] => 0 ],
+ # IP match
+ [ q[-R 'abc'] => undef ],
+ [ q[-R %{REMOTE_ADDR}] => undef ],
+ [ q[-R '240.0.0.0'] => 0 ],
+ [ q[-R '240.0.0.0/8'] => 0 ],
+ [ q[-R 'ff::/8'] => 0 ],
+ [ q[-R '127.0.0.1' || -R '::1'] => 1 ],
+ [ q['127.0.0.1' -ipmatch 'abc'] => undef ],
+ [ q['127.0.0.1' -ipmatch %{REMOTE_ADDR}] => undef ],
+ [ q['127.0.0.1' -ipmatch '240.0.0.0'] => 0 ],
+ [ q['127.0.0.1' -ipmatch '240.0.0.0/8'] => 0 ],
+ [ q['127.0.0.1' -ipmatch 'ff::/8'] => 0 ],
+ [ q['127.0.0.1' -ipmatch '127.0.0.0/8'] => 1 ],
+ # fn/strmatch
+ [ q['foo' -strmatch '*o'] => 1 ],
+ [ q['fo/o' -strmatch 'f*'] => 1 ],
+ [ q['foo' -strmatch 'F*'] => 0 ],
+ [ q['foo' -strcmatch 'F*'] => 1 ],
+ [ q['foo' -strmatch 'g*'] => 0 ],
+ [ q['foo' -strcmatch 'g*'] => 0 ],
+ [ q['a/b' -fnmatch 'a*'] => 0 ],
+ [ q['a/b' -fnmatch 'a/*'] => 1 ],
+ # error handling
+ [ q['%{foo:User-Agent}' != 'bar'] => undef ],
+ [ q[%{foo:User-Agent} != 'bar'] => undef ],
+ [ q[foo('bar') = 'bar'] => undef ],
+ [ q[%{FOO} != 'bar'] => undef ],
+ [ q['bar' = bar] => undef ],
+);
+
+#
+# Bool logic:
+# Test all combinations with 0 to 2 '||' or '&&' operators
+#
+my @bool_base = (
+ [ q[true] => 1 ],
+);
+push @bool_base, (
+ [ q[-z ''] => 1 ],
+ [ q[-n 'x'] => 1 ],
+ [ q[false] => 0 ],
+ [ q[-n ''] => 0 ],
+ [ q[-z 'x'] => 0 ],
+) if 0; # This produces an exessive number of tests for normal operation
+
+# negation function: perl's "!" returns undef for false, but we need 0
+sub neg
+{
+ return (shift) ? 0 : 1;
+}
+# also test combinations with '!' operator before each operand
+@bool_base = (@bool_base, map { ["!$_->[0]" => neg($_->[1]) ] } @bool_base);
+# now create the test cases
+my @bool_test_cases;
+foreach my $ex1 (@bool_base) {
+ my ($e1, $r1) = @$ex1;
+ push @bool_test_cases, [ $e1 => $r1 ];
+ foreach my $ex2 (@bool_base) {
+ my ($e2, $r2) = @$ex2;
+ push @bool_test_cases, [ "$e1 && $e2" => ($r1 && $r2) ];
+ push @bool_test_cases, [ "$e1 || $e2" => ($r1 || $r2) ];
+ foreach my $ex3 (@bool_base) {
+ my ($e3, $r3) = @$ex3;
+ foreach my $op1 ("||", "&&") {
+ foreach my $op2 ("||", "&&") {
+ my $r = eval "$r1 $op1 $r2 $op2 $r3";
+ push @bool_test_cases, [ "$e1 $op1 $e2 $op2 $e3" => $r];
+ }
+ }
+ }
+ }
+}
+push @test_cases, @bool_test_cases;
+# also test combinations with '!' operator before the whole expression
+push @test_cases, map { ["!($_->[0])" => neg($_->[1]) ] } @bool_test_cases;
+
+if (have_min_apache_version("2.3.13")) {
+ push(@test_cases, (
+ # functions
+ [ q[filesize('] . $file_foo . q[') = 4 ] => 1 ],
+ [ q[filesize('] . $file_notexist . q[') = 0 ] => 1 ],
+ [ q[filesize('] . $file_zero . q[') = 0 ] => 1 ],
+ # unary operators
+ [ qq[-d '$file_foo' ] => 0 ],
+ [ qq[-e '$file_foo' ] => 1 ],
+ [ qq[-f '$file_foo' ] => 1 ],
+ [ qq[-s '$file_foo' ] => 1 ],
+ [ qq[-d '$file_zero' ] => 0 ],
+ [ qq[-e '$file_zero' ] => 1 ],
+ [ qq[-f '$file_zero' ] => 1 ],
+ [ qq[-s '$file_zero' ] => 0 ],
+ [ qq[-d '$dir_foo' ] => 1 ],
+ [ qq[-e '$dir_foo' ] => 1 ],
+ [ qq[-f '$dir_foo' ] => 0 ],
+ [ qq[-s '$dir_foo' ] => 0 ],
+ [ qq[-d '$file_notexist' ] => 0 ],
+ [ qq[-e '$file_notexist' ] => 0 ],
+ [ qq[-f '$file_notexist' ] => 0 ],
+ [ qq[-s '$file_notexist' ] => 0 ],
+ [ qq[-F '$file_foo' ] => 1 ],
+ [ qq[-F '$file_notexist' ] => 0 ],
+ [ qq[-U '$url_foo' ] => 1 ],
+ [ qq[-U '$url_notexist' ] => 0 ],
+ ));
+}
+
+if (have_min_apache_version("2.4.5")) {
+ push(@test_cases, (
+ [ qq[sha1('foo') = '0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33' ] => 1 ],
+ [ qq[md5('foo') = 'acbd18db4cc2f85cedef654fccc4a4d8' ] => 1 ],
+ [ qq[base64('foo') = 'Zm9v' ] => 1 ],
+ [ qq[unbase64('Zm9vMg==') = 'foo2' ] => 1 ],
+ ));
+}
+
+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 }";
+
+ my $SAN_split = '.*?IP Address:([^,]+)';
+
+ push(@test_cases, (
+ [ "join {'a', 'b', 'c'} == 'abc'" => 1 ],
+ [ "join($SAN_list_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'" => 1 ],
+ [ "join($SAN_list_tuple, ', ') == join $SAN_list_one" => 1 ],
+ [ "join(split(s/$SAN_split/\$1/, $SAN_list_tuple), ', ') == " .
+ "'email:<redacted1>, email:<redacted2>, " .
+ "127.0.0.1, 0:0:0:0:0:0:0:1, 192.168.169.170'" => 1 ],
+ [ "join(split(s/$SAN_split/\$1/, $SAN_list_one), ', ') == " .
+ "'127.0.0.1, 0:0:0:0:0:0:0:1, 192.168.169.170'" => 1 ],
+ [ "'IP Address:192.168.169.170' -in $SAN_list_tuple" => 1 ],
+ [ "'192.168.169.170' -in split s/$SAN_split/\$1/, $SAN_list_tuple" => 1 ],
+ [ "'0:0:0:0:0:0:0:1' -in split s/$SAN_split/\$1/, $SAN_list_one" => 1 ],
+ [ "%{REMOTE_ADDR} -in split s/$SAN_split/\$1/, $SAN_list_one" => 1 ],
+ [ "'email:<redacted1>' -in split s/$SAN_split/\$1/, $SAN_list_tuple" => 1 ],
+ [ "'email:<redacted2>' -in split s/$SAN_split/\$1/, $SAN_list_one" => 0 ],
+ [ "'IP Address:%{REMOTE_ADDR}' -in split/, /, join $SAN_list_one"
+ => 1 ],
+ [ "replace(%{REQUEST_METHOD}, 'E', 'O') == 'GOT'" => 1],
+ [ "replace(%{REQUEST_METHOD}, 'E', 'O') == 'GET'" => 0],
+ ));
+}
+
+plan tests => scalar(@test_cases) + 1,
+ need need_lwp,
+ need_module('mod_authz_core'),
+ need_min_apache_version('2.3.9');
+
+t_start_error_log_watch();
+
+my %rc_map = ( 500 => 'parse error', 403 => 'true', 200 => 'false');
+foreach my $t (@test_cases) {
+ my ($expr, $expect) = @{$t};
+
+ write_htaccess($expr);
+
+ my $response = GET('/apache/expr/index.html',
+ 'SomeHeader' => 'SomeValue',
+ 'User-Agent' => 'SomeAgent',
+ 'Referer' => 'SomeReferer');
+ my $rc = $response->code;
+ if (!defined $expect) {
+ print qq{Should get parse error for "$expr", got $rc_map{$rc}\n};
+ ok($rc == 500);
+ }
+ elsif ($expect) {
+ print qq{"$expr" should evaluate to true, got $rc_map{$rc}\n};
+ ok($rc == 403);
+ }
+ else {
+ print qq{"$expr" should evaluate to false, got $rc_map{$rc}\n};
+ ok($rc == 200);
+ }
+}
+
+my @loglines = t_finish_error_log_watch();
+my @evalerrors = grep { /internal evaluation error/i } @loglines;
+my $num_errors = scalar @evalerrors;
+print "Error log should not have 'Internal evaluation error' entries, found $num_errors\n";
+ok($num_errors == 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" );
+<If "$expr">
+ Require all denied
+</If>
+EOF
+}
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-05 23:30:00 +0000