rt/t/web/redirect.t

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