summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/modules/setenvif.t
diff options
context:
space:
mode:
Diffstat (limited to 'debian/perl-framework/t/modules/setenvif.t')
-rw-r--r--debian/perl-framework/t/modules/setenvif.t193
1 files changed, 193 insertions, 0 deletions
diff --git a/debian/perl-framework/t/modules/setenvif.t b/debian/perl-framework/t/modules/setenvif.t
new file mode 100644
index 0000000..cb561c2
--- /dev/null
+++ b/debian/perl-framework/t/modules/setenvif.t
@@ -0,0 +1,193 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+my $vars = Apache::Test::vars();
+my $htdocs = Apache::Test::vars('documentroot');
+my $body;
+
+##
+## mod_setenvif tests
+##
+
+my $good_ua = '^libwww-perl/.*';
+my $bad_ua = 'foo-browser/0.1';
+
+my $page = "/modules/setenvif/htaccess/setenvif.shtml";
+my %var_att =
+ (
+ 'Remote_Host' =>
+ {
+ 'pass' => $vars->{remote_addr},
+ 'fail' => 'some.where.else.com'
+ },
+ 'Remote_Addr' =>
+ {
+ 'pass' => $vars->{remote_addr},
+ 'fail' => '63.125.18.195'
+ },
+ 'Request_Method' =>
+ {
+ 'pass' => 'GET',
+ 'fail' => 'POST'
+ },
+ 'Request_Protocol' =>
+ {
+ 'pass' => 'HTTP',
+ 'fail' => 'FTP'
+ },
+ 'Request_URI' =>
+ {
+ 'pass' => $page,
+ 'fail' => 'foo.html'
+ },
+ # Test with a regex. Looking for 'User-Agent'
+ '^User-Ag' =>
+ {
+ 'pass' => $good_ua,
+ 'fail' => $bad_ua
+ }
+ );
+
+my @var = qw(VAR_ONE VAR_TWO VAR_THREE);
+
+my $htaccess = "$htdocs/modules/setenvif/htaccess/.htaccess";
+
+plan tests => @var * 10 + (keys %var_att) * 6 * @var + 4,
+ have_module qw(setenvif include);
+
+sub write_htaccess {
+ my $string = shift;
+ open (HT, ">$htaccess") or die "can't open $htaccess: $!";
+ print HT $string;
+ close(HT);
+}
+
+sub test_all_vars {
+ my $exp_modifier = shift;
+ my $conf_str = shift;
+ my $set = 'set';
+
+ my ($actual, $expected);
+ foreach my $var (@var) {
+ $conf_str .= " $var=$set";
+ write_htaccess($conf_str);
+ $expected = set_expect($exp_modifier, $conf_str);
+ $actual = GET_BODY $page;
+ $actual =~ s/\r//sg; #win32
+
+ print "---\n";
+ print "conf:\n$conf_str\n";
+ print "expecting:\n->$expected<-\n";
+ print "got:\n->$actual<-\n";
+
+ ok ($actual eq $expected);
+ }
+}
+
+sub set_expect {
+ my $not = shift;
+ my $conf_str = shift;
+ my ($v, $exp_str) = ('','');
+
+ my %exp =
+ (
+ 1 => 'VAR_ONE',
+ 2 => 'VAR_TWO',
+ 3 => 'VAR_THREE'
+ );
+
+ foreach (sort keys %exp) {
+ my $foo = $exp{$_};
+ $v = '(none)';
+ if ($conf_str =~ /$foo=(\S+)/) {
+ $v = $1 unless $not;
+ }
+
+ $exp_str .= "$_:$v\n";
+ }
+
+ return $exp_str;
+}
+
+## test simple browser match ##
+test_all_vars(0,"BrowserMatch $good_ua");
+test_all_vars(1,"BrowserMatch $bad_ua");
+
+## test SetEnvIf with variable attributes ##
+foreach my $attribute (sort keys %var_att) {
+ test_all_vars(0,"SetEnvIf $attribute $var_att{$attribute}{pass}");
+ test_all_vars(1,"SetEnvIf $attribute $var_att{$attribute}{fail}");
+
+ ## some 'relaying' variables ##
+ test_all_vars(0,
+ "SetEnvIf $attribute $var_att{$attribute}{pass} RELAY=1\nSetEnvIf RELAY 1");
+ test_all_vars(1,
+ "SetEnvIf $attribute $var_att{$attribute}{pass} RELAY=1\nSetEnvIf RELAY 0");
+
+ ## SetEnvIfNoCase tests ##
+ my $uc = uc $var_att{$attribute}{pass};
+ test_all_vars(0,"SetEnvIfNoCase $attribute $uc");
+ $uc = uc $var_att{$attribute}{fail};
+ test_all_vars(1,"SetEnvIfNoCase $attribute $uc");
+}
+
+## test 'relaying' variables ##
+test_all_vars(0,"BrowserMatch $good_ua RELAY=1\nSetEnvIf RELAY 1");
+test_all_vars(0,
+ "BrowserMatch $good_ua RELAY=1\nSetEnvIf RELAY 1 R2=1\nSetEnvIf R2 1");
+test_all_vars(1,
+ "BrowserMatch $good_ua RELAY=1\nSetEnvIf RELAY 1 R2=1\nSetEnvIf R2 0");
+test_all_vars(1,"BrowserMatch $good_ua RELAY=0\nSetEnvIf RELAY 1");
+test_all_vars(1,"BrowserMatch $good_ua RELAY=1\nSetEnvIf RELAY 0");
+
+## test '!' ##
+# We set then unset 'R2' (see a few lines above for the corresponding test, without the 'unset'
+test_all_vars(1,
+ "BrowserMatch $good_ua RELAY=1\nSetEnvIf RELAY 1 R2=1\nSetEnvIf RELAY 1 !R2\nSetEnvIf R2 1");
+
+## test SetEnvIfExpr ##
+test_all_vars(0, "SetEnvIfExpr \"%{REQUEST_URI} =~ /\.shtml\$/\"");
+test_all_vars(1, "SetEnvIfExpr \"%{REQUEST_URI} =~ /\.foo\$/\"");
+
+## test SetEnvIfExpr with replacement ##
+write_htaccess("SetEnvIfExpr \"%{REQUEST_URI} =~ /\.\(sh\)tml\$/\" VAR_ONE=\$0 VAR_TWO=\$1");
+$body = GET_BODY $page;
+ok t_cmp($body, "1:.shtml\n2:sh\n3:(none)\n");
+
+write_htaccess("SetEnvIfExpr \"%{REQUEST_URI} !~ /\.\(sh\)tml\$/\" VAR_ONE=\$0 VAR_TWO=\$1");
+$body = GET_BODY $page;
+ok t_cmp($body, "1:(none)\n2:(none)\n3:(none)\n");
+
+## test SetEnvIfExpr with replacement when regex does NOT match ##
+write_htaccess("SetEnvIfExpr \"%{REQUEST_URI} =~ /\.\(sh\)tmlXXX\$/\" VAR_ONE=\$0 VAR_TWO=\$1");
+$body = GET_BODY $page;
+ok t_cmp($body, "1:(none)\n2:(none)\n3:(none)\n");
+
+if (need_min_apache_version("2.4.38")) {
+ ## test SetEnvIfExpr with replacement when regex is REQUIRED to NOT match ##
+ write_htaccess("SetEnvIfExpr \"%{REQUEST_URI} !~ /\.\(sh\)tmlXXX\$/\" VAR_ONE=\$0 VAR_TWO=\$1");
+ $body = GET_BODY $page;
+ ok t_cmp($body, "1:\$0\n2:\$1\n3:(none)\n");
+}
+else {
+ # Skip for versions without r1786235 backported
+ skip "skipping inverted match test with version <2.4.38"
+}
+
+## i think this should work, but it doesnt.
+## leaving it commented now pending investigation.
+## seems you cant override variables that have been previously set.
+##
+## test_all_vars(0,
+## "SetEnv RELAY 1\nSetEnvIf RELAY 1 RELAY=2\nSetEnvIf RELAY 2");
+## test_all_vars(0,
+## "BrowserMatch $good_ua RELAY=1\nSetEnvIf RELAY 1 RELAY=2\nSetEnvIf RELAY 2");
+##
+##
+
+## clean up ##
+unlink $htaccess if -e $htaccess;