Fixed security hole in Pinto::Server.

The file responder would serve up files outside
the repository if you asked for a path like
"../../../../etc/passwd" for example.

Changes

@@ -1,5 +1,10 @@
 {{$NEXT}}
 
+      [SECURITY]
+
+      - Fixed critical security hole in Pinto::Server. If you are using pintod,
+      please upgrade now! Thanks to Aran Deltac for reporting this.
+
       [ENHANCEMENTS]
 
       - The "install" command now has an --all option that will install every

lib/Pinto/Server/Responder/File.pm

@@ -24,16 +24,12 @@ sub respond {
 
     # e.g. /stack_name/modules/02packages.details.txt.gz
     my ( undef, @path_parts ) = split '/', $self->request->path_info;
-
     my $file = $self->root->file(@path_parts);
 
-    my @stat = stat($file);
-    unless ( -f _ ) {
-        my $body = "File $file not found";
-        my $headers = [ 'Content-Type' => 'text/plain', 'Content-Length' => length($body) ];
-        return [ 404, $headers, [$body] ];
-    }
+    return not_found($file) if not -f $file;
+    return not_found($file) if index($file, '/../') > 0;
 
+    my @stat = stat($file);
     my $modified_since = HTTP::Date::str2time( $self->request->env->{HTTP_IF_MODIFIED_SINCE} );
     return [ 304, [], [] ] if $modified_since && $stat[9] <= $modified_since;
 
@@ -78,6 +74,15 @@ sub should_not_cache {
 
 #-------------------------------------------------------------------------------
 
+sub not_found {
+    my $file = shift;
+    my $body = "File $file not found";
+    my $headers = [ 'Content-Type' => 'text/plain', 'Content-Length' => length($body) ];
+    return [ 404, $headers, [$body] ];
+}
+
+#-------------------------------------------------------------------------------
+
 __PACKAGE__->meta->make_immutable;
 
 #-------------------------------------------------------------------------------

t/04-server/03-security.t

@@ -0,0 +1,48 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+
+use Pinto::Server;
+use Pinto::Constants qw(:server :protocol);
+
+use lib 't/lib';
+use Pinto::Tester;
+
+#------------------------------------------------------------------------------
+# Setup...
+
+my $t       = Pinto::Tester->new;
+my %opts    = ( root => $t->pinto->root );
+my $app     = Pinto::Server->new(%opts)->to_app;
+
+#------------------------------------------------------------------------------
+# GET a path outside the repository
+
+test_psgi
+    app    => $app,
+    client => sub {
+        my $cb  = shift;
+
+        my $base = 'foobar.txt';
+        my $file = $t->pinto->root->parent->file("$base");
+
+        unless ($file->open('w')) {
+            pass && diag 'Cannot create test file, skipping test';
+            return;
+        }
+
+        my $req = GET("../$base");
+        is $cb->($req)->code, 404, 'Status of files outside repo';
+        $file->remove if -e $file;
+    };
+
+#------------------------------------------------------------------------------
+
+done_testing;
+