<mst> I've put something like that in a sub prepare before now
<mst> we should maybe have a config option to override base
<mst> patches would be welcome :)
Here's an attempt. I've never really hacked on the core before, so please go
easy. Also I know that POD isn't included, but that's because I can't figure
out where it belongs. I'll write it, given a place to put it.
Anyway, this is a patch to create a pair of config keys tell
Engine::CGI "ignore what the server thinks the base path is, and use these
instead". It's useful in the case that someone has their application
port-forwarded, load-balanced, proxied, etc. through some sort of device that
doesn't set X-Forwarded-Host.
How it works: If no config is provided, life continues as it always has. If
the request is HTTP and $c->config->{override_base_uri} is set, we use that
as $c->req->base. If the request is HTTPS and
$c->config->{override_base_uri_secure} is set, we use that as $c->req->base.
If the request is HTTPS and override_base_uri_secure isn't set, but
override_base_uri is, we use override_base_uri and switch its scheme to https
(hopefully it doesn't have a port).
Patch against Catalyst-Runtime/5.80/trunk which I hope is the right thing.
Comments appreciated,
Andrew
Index: t/unit_engine_cgi.t
===================================================================
--- t/unit_engine_cgi.t (revision 0)
+++ t/unit_engine_cgi.t (revision 0)
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use URI;
+
+use_ok('Catalyst');
+
+my $http_request = Catalyst::Request->new( { secure => 0 } );
+my $https_request = Catalyst::Request->new( { secure => 1 } );
+
+$ENV{HTTP_HOST} = "127.0.0.1";
+$ENV{SERVER_PORT} = 80;
+$ENV{SCRIPT_NAME} = '/catalyst.fcgi';
+
+my $context = Catalyst->new( {
+ request => $http_request,
+ namespace => 'yada',
+ } );
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'http://127.0.0.1/catalyst.fcgi/pants',
+ 'Base URI'
+);
+
+$context = Catalyst->new( {
+ request => $http_request,
+ namespace => 'yada',
+ } );
+$context->config->{override_base_uri} = "http://127.1.2.3/";;
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'http://127.1.2.3/pants',
+ 'Overriden base URI'
+);
+
+$context = Catalyst->new( {
+ request => $https_request,
+ namespace => 'yada',
+ } );
+$context->config->{override_base_uri} = "http://127.1.2.3/";;
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'https://127.1.2.3/pants',
+ 'Overriden base URI for HTTPS'
+);
+
+$context = Catalyst->new( {
+ request => $https_request,
+ namespace => 'yada',
+ } );
+$context->config->{override_base_uri} = "http://127.1.2.3/";;
+$context->config->{override_base_uri_secure} = "https://127.1.2.4/";;
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'https://127.1.2.4/pants',
+ 'Overriden base URI for HTTPS'
+);
+
Index: lib/Catalyst/Engine/CGI.pm
===================================================================
--- lib/Catalyst/Engine/CGI.pm (revision 8518)
+++ lib/Catalyst/Engine/CGI.pm (working copy)
@@ -160,11 +160,25 @@
$c->request->uri( bless \$uri, $uri_class );
# set the base URI
+
+ my $base_uri;
+
+ if (defined $c->config->{override_base_uri_secure} && $c->request->secure) {
+ # Config gives us an override base for HTTPS. Use it directly.
+ $base_uri = $c->config->{override_base_uri_secure};
+ } elsif (defined $c->config->{override_base_uri}) {
+ # Use an overriden base. If we're secure, but there's no separate HTTPS
+ # base URI, then just change the scheme on the standard one.
+ $base_uri = $c->config->{override_base_uri};
+ $base_uri =~ s,^([^:]+)://,${scheme}://,;
+ } else {
+ # Use the server-provided (default) base path.
+ $base_uri = $scheme . '://' . $host . $base_path;
+ }
+
# base must end in a slash
- $base_path .= '/' unless $base_path =~ m{/$};
+ $base_uri .= '/' unless $base_uri =~ m{/$};
- my $base_uri = $scheme . '://' . $host . $base_path;
-
$c->request->base( bless \$base_uri, $uri_class );
}
_______________________________________________
List: Catalyst@lists.scsys.co.uk
Listinfo: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
Searchable archive: http://www.mail-archive.com/catalyst@lists.scsys.co.uk/
Dev site: http://dev.catalyst.perl.org/
