File Coverage

blib/lib/Plack/App/File.pm

Criterion	Covered	Total	%
statement	75	81	92.5
branch	21	26	80.7
condition	8	11	72.7
subroutine	17	17	100.0
pod	1	8	12.5
total	122	143	85.3

package Plack::App::File;
use strict;
use warnings;
use parent qw/Plack::Component/;
use File::Spec::Unix;
use Cwd ();
use Plack::Util;
use Plack::MIME;
use HTTP::Date;

use Plack::Util::Accessor qw( root file content_type encoding );

sub should_handle {
    my($self, $file) = @_;
    return -f $file;
}

sub call {
    my $self = shift;
    my $env  = shift;

    my($file, $path_info) = $self->file || $self->locate_file($env);
    return $file if ref $file eq 'ARRAY';

    if ($path_info) {
        $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
        $env->{'plack.file.SCRIPT_NAME'} =~ s/\Q$path_info\E$//;
        $env->{'plack.file.PATH_INFO'}   = $path_info;
    } else {
        $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
        $env->{'plack.file.PATH_INFO'}   = '';
    }

    return $self->serve_path($env, $file);
}

sub locate_file {
    my($self, $env) = @_;

    my $path = $env->{PATH_INFO} || '';

    if ($path =~ /\0/) {
        return $self->return_400;
    }

    my $docroot = $self->root || ".";
    my @path = split /[\\\/]/, $path, -1; # -1 *MUST* be here to avoid security issues!
    if (@path) {
        shift @path if $path[0] eq '';
    } else {
        @path = ('.');
    }

    if (grep /^\.{2,}$/, @path) {
        return $self->return_403;
    }

    my($file, @path_info);
    while (@path) {
        my $try = File::Spec::Unix->catfile($docroot, @path);
        if ($self->should_handle($try)) {
            $file = $try;
            last;
        } elsif (!$self->allow_path_info) {
            last;
        }
        unshift @path_info, pop @path;
    }

    if (!$file) {
        return $self->return_404;
    }

    if (!-r $file) {
        return $self->return_403;
    }

    return $file, join("/", "", @path_info);
}

sub allow_path_info { 0 }

sub serve_path {
    my($self, $env, $file) = @_;

    my $content_type = $self->content_type || Plack::MIME->mime_type($file)
                       || 'text/plain';

    if ("CODE" eq ref $content_type) {
		$content_type = $content_type->($file);
    }

    if ($content_type =~ m!^text/!) {
        $content_type .= "; charset=" . ($self->encoding || "utf-8");
    }

    open my $fh, "<:raw", $file
        or return $self->return_403;

    my @stat = stat $file;

    Plack::Util::set_io_path($fh, Cwd::realpath($file));

    return [
        200,
        [
            'Content-Type'   => $content_type,
            'Content-Length' => $stat[7],
            'Last-Modified'  => HTTP::Date::time2str( $stat[9] )
        ],
        $fh,
    ];
}

sub return_403 {
    my $self = shift;
    return [403, ['Content-Type' => 'text/plain', 'Content-Length' => 9], ['forbidden']];
}

sub return_400 {
    my $self = shift;
    return [400, ['Content-Type' => 'text/plain', 'Content-Length' => 11], ['Bad Request']];
}

# Hint: subclasses can override this to return undef to pass through 404
sub return_404 {
    my $self = shift;
    return [404, ['Content-Type' => 'text/plain', 'Content-Length' => 9], ['not found']];
}

1;
__END__