Adding debian version 2.4.56-1~deb11u2.debian/2.4.56-1_deb11u2debian

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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
+}
+