1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
#!/usr/bin/perl
use strict;
use warnings;
use RT::Test tests => 13;
my $r = $HTML::Mason::Commands::r = bless {}, 'R';
my $m = $HTML::Mason::Commands::m = bless {}, 'M';
set_config(
CanonicalizeRedirectURLs => 0,
WebDomain => 'localhost',
WebPort => 80,
WebPath => '',
);
is( RT->Config->Get('WebBaseURL'), 'http://localhost' );
is( RT->Config->Get('WebURL'), 'http://localhost/' );
redirect_ok(
'http://localhost/Ticket/', 'http://localhost/Ticket/',
{ SERVER_NAME => 'localhost', SERVER_PORT => 80 },
);
redirect_ok(
'/Ticket/', 'http://localhost/Ticket/',
{ SERVER_NAME => 'localhost', SERVER_PORT => 80 },
);
redirect_ok(
'http://localhost/Ticket/', 'http://example.com/Ticket/',
{ SERVER_NAME => 'example.com', SERVER_PORT => 80 },
);
set_config(
CanonicalizeRedirectURLs => 0,
WebDomain => 'localhost',
WebPort => 443,
WebPath => '',
);
is( RT->Config->Get('WebBaseURL'), 'https://localhost' );
is( RT->Config->Get('WebURL'), 'https://localhost/' );
redirect_ok(
'https://localhost/Ticket/', 'https://localhost/Ticket/',
{ SERVER_NAME => 'localhost', SERVER_PORT => 443, HTTPS => 'on' },
);
redirect_ok(
'/Ticket/', 'https://localhost/Ticket/',
{ SERVER_NAME => 'localhost', SERVER_PORT => 443, HTTPS => 'on' },
);
redirect_ok(
'https://localhost/Ticket/', 'http://localhost/Ticket/',
{ SERVER_NAME => 'localhost', SERVER_PORT => 80 },
);
redirect_ok(
'/Ticket/', 'http://localhost/Ticket/',
{ SERVER_NAME => 'localhost', SERVER_PORT => 80 },
);
redirect_ok(
'https://localhost/Ticket/', 'http://example.com/Ticket/',
{ SERVER_NAME => 'example.com', SERVER_PORT => 80 },
);
redirect_ok(
'https://localhost/Ticket/', 'https://example.com/Ticket/',
{ SERVER_NAME => 'example.com', SERVER_PORT => 443, HTTPS => 'on' },
);
sub set_config {
my %values = @_;
while ( my ($k, $v) = each %values ) {
RT->Config->Set( $k => $v );
}
unless ( $values{'WebBaseURL'} ) {
my $port = RT->Config->Get('WebPort');
RT->Config->Set(
WebBaseURL =>
($port == 443? 'https': 'http') .'://'
. RT->Config->Get('WebDomain')
. ($port != 80 && $port != 443? ":$port" : '')
);
}
unless ( $values{'WebURL'} ) {
RT->Config->Set(
WebURL => RT->Config->Get('WebBaseURL') . RT->Config->Get('WebPath') . "/"
);
}
}
sub redirect_ok {
my ($to, $expected, $env, $details) = @_;
local %ENV = %ENV;
while ( my ($k, $v) = each %{ $env || {} } ) {
$ENV{ $k } = $v;
}
RT::Interface::Web::Redirect( $to );
is($m->redirect, $expected, $details || "correct for '$to'");
}
package R;
sub status {};
package M;
sub redirect { $_[0]{'last'} = $_[1] if @_ > 1; return $_[0]{'last'} }
sub abort {}
|