Add behind proxy middleware

dist.ini

@@ -64,6 +64,9 @@ MIME::Types = 0
 MIME::Base64 = 3.13
 ; added the "wrap" method in Plack::Builder
 Plack = 1.0016
+; BehindProxy middleware
+Plack::Middleware::ReverseProxy = 0
+Plack::Middleware::ReverseProxyPath = 0
 ; JSON is just a serialiser, so in theory should be optional.
 ; But it is used in the DSL (send_error) and in tests.
 ; And also so much used in apps...

lib/Dancer2/Core/App.pm

@@ -413,9 +413,6 @@ sub _init_for_context {
 
     return if !defined $self->context;
     return if !defined $self->context->request;
-
-    $self->context->request->is_behind_proxy(1)
-      if $self->setting('behind_proxy');
 }
 
 sub supported_hooks {

lib/Dancer2/Core/Request.pm

@@ -339,21 +339,8 @@ has body_is_parsed => (
     default => sub {0},
 );
 
-has is_behind_proxy => (
-    is      => 'rw',
-    isa     => Bool,
-    default => sub {0},
-);
-
 sub host {
-    my ($self) = @_;
-
-    if ( $self->is_behind_proxy ) {
-        my @hosts = split /\s*,\s*/, $self->env->{HTTP_X_FORWARDED_HOST}, 2;
-        return $hosts[0];
-    } else {
-        return $self->env->{'HTTP_HOST'};
-    }
+    return shift->env->{'HTTP_HOST'};
 }
 
 
@@ -427,26 +414,10 @@ Return the scheme of the request
 
 =cut
 
-
 sub scheme {
-    my ($self) = @_;
-    my $scheme;
-    if ( $self->is_behind_proxy ) {
-        # Note the 'HTTP_' prefix the PSGI spec adds to headers.
-        $scheme =
-             $self->env->{'HTTP_X_FORWARDED_PROTOCOL'}
-          || $self->env->{'HTTP_X_FORWARDED_PROTO'}
-          || $self->env->{'HTTP_FORWARDED_PROTO'}
-          || "";
-    }
-    return
-         $scheme
-      || $self->env->{'psgi.url_scheme'}
-      || $self->env->{'PSGI.URL_SCHEME'}
-      || "";
+    return $_[0]->env->{'psgi.url_scheme'} || "";
 }
 
-
 has serializer => (
     is        => 'ro',
     isa       => Maybe( ConsumerOf ['Dancer2::Core::Role::Serializer'] ),

lib/Dancer2/Core/Role/ConfigReader.pm

@@ -89,6 +89,11 @@ has global_triggers => (
             my ( $self, $handler ) = @_;
             Dancer2->runner->config->{'apphandler'} = $handler;
         },
+
+        behind_proxy => sub {
+            my ( $self, $flag ) = @_;
+            Dancer2->runner->config->{'behind_proxy'} = $flag;
+        },
     } },
 );
 

lib/Dancer2/Core/Runner.pm

@@ -6,7 +6,10 @@ use Dancer2::Core::MIME;
 use Dancer2::Core::Types;
 use Dancer2::Core::Dispatcher;
 use HTTP::Server::PSGI;
-use Plack::Builder qw();
+
+use Plack::Middleware::Head;
+use Plack::Middleware::Conditional;
+use Dancer2::Middleware::BehindProxy;
 
 with 'Dancer2::Core::Role::ConfigReader';
 
@@ -240,9 +243,13 @@ sub psgi_app {
         return $response;
     };
 
-    my $builder = Plack::Builder->new;
-    $builder->add_middleware('Head');
-    return $builder->wrap($psgi);
+    $psgi = Plack::Middleware::Conditional->wrap(
+        $psgi,
+        builder   => sub { Dancer2::Middleware::BehindProxy->wrap($_[0]) },
+        condition => sub { $self->config->{'behind_proxy'} },
+    );
+    $psgi = Plack::Middleware::Head->wrap($psgi);
+    return $psgi;
 }
 
 sub print_banner {

lib/Dancer2/Middleware/BehindProxy.pm

@@ -0,0 +1,58 @@
+package Dancer2::Middleware::BehindProxy;
+# ABSTRACT: Support Dancer2 apps when operating behing a reverse proxy
+
+use warnings;
+use strict;
+
+use parent 'Plack::Middleware';
+use Plack::Middleware::ReverseProxy;
+use Plack::Middleware::ReverseProxyPath;
+
+sub call {
+    my($self, $env) = @_;
+
+    # Plack::Middleware::ReverseProxy only supports
+    # HTTP_X_FORWARDED_PROTO whereas Dancer2 also supports
+    # HTTP_X_FORWARDED_PROTOCOL and HTTP_FORWARDED_PROTO
+    for my $header (qw/HTTP_X_FORWARDED_PROTOCOL HTTP_FORWARDED_PROTO/) {
+        if ( ! $env->{HTTP_X_FORWARDED_PROTO}
+             && $env->{$header} )
+        {
+            $env->{HTTP_X_FORWARDED_PROTO} = $env->{$header};
+            last;
+        }
+    }
+
+    # Pr#503 added support for HTTP_X_FORWARDED_HOST containing multiple
+    # values. Plack::Middleware::ReverseProxy takes the last (most recent)
+    # whereas that #503 takes the first.
+    if ( $env->{HTTP_X_FORWARDED_HOST} ) {
+        my @hosts = split /\s*,\s*/, $env->{HTTP_X_FORWARDED_HOST}, 2;
+        $env->{HTTP_X_FORWARDED_HOST} = $hosts[0];
+    }
+
+    # Plack::Middleware::ReverseProxyPath uses X-Forwarded-Script-Name
+    # whereas Dancer previously supported HTTP_REQUEST_BASE
+    if ( ! $env->{HTTP_X_FORWARDED_SCRIPT_NAME}
+         && $env->{HTTP_REQUEST_BASE} )
+    {
+         $env->{HTTP_X_FORWARDED_SCRIPT_NAME} = $env->{HTTP_REQUEST_BASE};
+    }
+
+    # Wrap in reverse proxy middleware and call the wrapped app
+    my $app = Plack::Middleware::ReverseProxyPath->wrap($self->app);
+    $app = Plack::Middleware::ReverseProxy->wrap($app);
+    return $app->($env);
+}
+
+1;
+
+__END__
+
+=head1 DESCRIPTION
+
+Modifies request headers supported by L<Dancer2> altered by reverse proxies before
+wraping the request in the commonly used reverse proxy PSGI middlewares;
+L<Plack::Middleware::ReverseProxy> and L<Plack::Middleware::ReverseProxyPath>.
+
+=cut

t/redirect.t

@@ -144,8 +144,9 @@ subtest 'redirect behind a proxy' => sub {
                 $cb->(
                     GET '/test2/bounce',
                     'X-FORWARDED-HOST' => 'nice.host.name',
+                    'X-Forwarded-Script-Name' => '/myapp',
                 )->headers->header('Location'),
-                'http://nice.host.name/test2',
+                'http://nice.host.name/myapp/test2',
                 'behind a proxy, host() is read from X_FORWARDED_HOST',
             );
         }
@@ -156,32 +157,22 @@ subtest 'redirect behind a proxy' => sub {
                     GET '/test2/bounce',
                     'X-FORWARDED-HOST' => 'nice.host.name',
                     'FORWARDED-PROTO'  => 'https',
+                    'Request-Base' => '/myapp',
                 )->headers->header('Location'),
-                'https://nice.host.name/test2',
+                'https://nice.host.name/myapp/test2',
                 '... and the scheme is read from HTTP_FORWARDED_PROTO',
             );
         }
 
-        {
-            is(
-                $cb->(
-                    GET '/test2/bounce',
-                    'X-FORWARDED-HOST'     => 'nice.host.name',
-                    'X-FORWARDED-PROTOCOL' => 'ftp', # stupid, but why not?
-                )->headers->header('Location'),
-                'ftp://nice.host.name/test2',
-                '... or from X_FORWARDED_PROTOCOL',
-            );
-        }
-
         {
             is(
                 $cb->(
                     GET '/test2/bounce',
                     'X-FORWARDED-HOST'  => 'nice.host.name',
                     'X-FORWARDED-PROTO' => 'https',
+                    'X-Forwarded-Script-Name' => '/myapp',
                 )->headers->header('Location'),
-                'https://nice.host.name/test2',
+                'https://nice.host.name/myapp/test2',
                 '... or from X_FORWARDED_PROTO',
             );
         }
@@ -226,18 +217,6 @@ subtest 'redirect behind multiple proxies' => sub {
                 '... and the scheme is read from HTTP_FORWARDED_PROTO',
             );
         }
-
-        {
-            is(
-                $cb->(
-                    GET '/test2/bounce',
-                    'X-FORWARDED-HOST'     => "proxy1.example, proxy2.example",
-                    'X-FORWARDED-PROTOCOL' => 'ftp', # stupid, but why not?
-                )->headers->header('Location'),
-                'ftp://proxy1.example/test2',
-                '... or from X_FORWARDED_PROTOCOL',
-            );
-        }
     };
 };
 

t/request.t

@@ -95,16 +95,6 @@ sub run_test {
         is $req->base, 'http://oddhostname:5000/foo';
     }
 
-    note "testing behind proxy"; {
-        my $req = Dancer2::Core::Request->new(
-            env             => $env,
-            is_behind_proxy => 1
-        );
-        is $req->secure, 1;
-        is $req->host,   $env->{HTTP_X_FORWARDED_HOST};
-        is $req->scheme, 'https';
-    }
-
     note "testing path, dispatch_path and uri_base"; {
         # Base env used for path, dispatch_path and uri_base tests
         my $base = {