diff options
Diffstat (limited to 'debian/perl-framework/t/modules/setenvif.t')
| -rw-r--r-- | debian/perl-framework/t/modules/setenvif.t | 193 |
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; |