Remove behind_proxy handling from D2::Core::Request

Author: veryrusty

lib/Dancer2/Core/Request.pm

@@ -130,40 +130,17 @@ sub _set_route_params {
 # XXX: incompatible with Plack::Request
 sub uploads { $_[0]->{'uploads'} }
 
-sub is_behind_proxy { $_[0]->{'is_behind_proxy'} || 0 }
-
 sub host {
-    my ($self) = @_;
-
-    if ( $self->is_behind_proxy and exists $self->env->{'HTTP_X_FORWARDED_HOST'} ) {
-        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'};
 }
 
 # aliases, kept for backward compat
 sub agent                 { shift->user_agent }
 sub remote_address        { shift->address }
+
 sub forwarded_for_address { shift->env->{'HTTP_X_FORWARDED_FOR'} }
 sub forwarded_host        { shift->env->{'HTTP_X_FORWARDED_HOST'} }
-
-# there are two options
-sub forwarded_protocol    {
-    $_[0]->env->{'HTTP_X_FORWARDED_PROTO'}    ||
-    $_[0]->env->{'HTTP_X_FORWARDED_PROTOCOL'} ||
-    $_[0]->env->{'HTTP_FORWARDED_PROTO'}
-}
-
-sub scheme {
-    my ($self) = @_;
-    my $scheme = $self->is_behind_proxy
-               ? $self->forwarded_protocol
-               : '';
-
-    return $scheme || $self->env->{'psgi.url_scheme'};
-}
+sub forwarded_protocol    { shift->env->{'HTTP_X_FORWARDED_PROTO'} }
 
 sub serializer { $_[0]->{'serializer'} }
 

t/classes/Dancer2-Handler-File/merge_paths.t

@@ -0,0 +1,81 @@
+use strict;
+use warnings;
+use Test::More 'tests' => 6;
+use File::Spec;
+use Path::Tiny ();
+use Dancer2::FileUtils qw< path >;
+
+# This module tests merge_paths can be properly replaced by Path::Tiny::path()
+# It addresses the following comment by @wchristian, written bellow.
+
+# We removed this subroutine but still need to verify we converted correctly
+sub merge_paths {
+    my ( undef, $path, $public_dir ) = @_;
+
+    my ( $volume, $dirs, $file ) = File::Spec->splitpath( $path );
+    my @tokens = File::Spec->splitdir( "$dirs$file" );
+    my $updir = File::Spec->updir;
+    return if grep $_ eq $updir, @tokens;
+
+    my ( $pub_vol, $pub_dirs, $pub_file ) = File::Spec->splitpath( $public_dir );
+    my @pub_tokens = File::Spec->splitdir( "$pub_dirs$pub_file" );
+    return if length $volume and length $pub_vol and $volume ne $pub_vol;
+
+    my @final_vol = ( length $pub_vol ? $pub_vol : length $volume ? $volume : () );
+    my @file_path = ( @final_vol, @pub_tokens, @tokens );
+    my $file_path = path( @file_path );
+    return $file_path;
+}
+
+# From GH #1264:
+#
+#   That merge_paths commit is no good in that form, i'm afraid.
+#
+#   All of these should throw errors instead of "succeeding", otherwise they present huge security problems and/or break tests on systems with more than one file system tree. @haarg probably has other ideas of how this could break as well.
+#
+#   C:\Users\Mithaldu>perl -e "use Path::Tiny; print Path::Tiny::path( 'c:/meep', 'c:/marp' )->stringify"
+#   C:/meep/c:/marp
+#   C:\Users\Mithaldu>perl -e "use Path::Tiny; print Path::Tiny::path( 'c:/meep', 'd:/marp' )->stringify"
+#   C:/meep/d:/marp
+#   C:\Users\Mithaldu>perl -e "use Path::Tiny; print Path::Tiny::path( 'c:/meep', '../marp' )->stringify"
+#   C:/marp
+#
+#   The first two are both straight-up non-sense in the vein of merge_path( "~/.ssh", "ftp://some.server/whatever" ) so they should error out, nothing else.
+#   The third is "merely" dangerous and should be prevented.
+
+
+is(
+    merge_paths( undef, 'c:/meep', 'c:/marp' ),
+    'c:/marp/c:/meep',
+    'merge_paths: c:/meep + c:/marp',
+);
+
+is(
+    Path::Tiny::path( 'c:/meep', 'c:/marp' ),
+    'c:/meep/c:/marp',
+    'Path::Tiny: c:/meep + c:/marp',
+);
+
+is(
+    merge_paths( undef, 'c:/meep', 'd:/marp' ),
+    'd:/marp/c:/meep',
+    'merge_paths: c:/meep + d:/marp',
+);
+
+is(
+    Path::Tiny::path( 'c:/meep', 'd:/marp' ),
+    'c:/meep/d:/marp',
+    'Path::Tiny: c:/meep + d:/marp',
+);
+
+is(
+    merge_paths( undef, 'c:/meep', '../marp' ),
+    '../marp/c:/meep',
+    'merge_paths: c:/meep + ../marp',
+);
+
+is(
+    Path::Tiny::path( 'c:/meep', '../marp' ),
+    'c:/meep/../marp',
+    'Path::Tiny: c:/meep + ../marp',
+);

t/request.t

@@ -97,31 +97,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 behind proxy when optional headers are not set"; {
-		# local modifications to env:
-        local $env->{HTTP_HOST} = 'oddhostname:5000';
-        delete local $env->{'HTTP_X_FORWARDED_FOR'};
-        delete local $env->{'HTTP_X_FORWARDED_HOST'};
-        delete local $env->{'HTTP_X_FORWARDED_PROTOCOL'};
-        my $req = Dancer2::Core::Request->new(
-            env             => $env,
-            is_behind_proxy => 1
-        );
-        is ! $req->secure, 1;
-        is $req->host,   'oddhostname:5000';
-        is $req->scheme, 'http';
-    }
-
     note "testing path and uri_base"; {
         # Base env used for path and uri_base tests
         my $base = {