view release on metacpan or  search on metacpan

lib/PAGI/App/File.pm  view on Meta::CPAN

    jpg  => 'image/jpeg',
    jpeg => 'image/jpeg',
    gif  => 'image/gif',
    svg  => 'image/svg+xml',
    ico  => 'image/x-icon',
    webp => 'image/webp',
    woff => 'font/woff',
    woff2=> 'font/woff2',
    ttf  => 'font/ttf',
    pdf  => 'application/pdf',
    zip  => 'application/zip',
    mp3  => 'audio/mpeg',
    mp4  => 'video/mp4',
    webm => 'video/webm',
);

sub new {
    my ($class, %args) = @_;

    my $root = $args{root} // '.';
    # Resolve root to absolute path for security comparisons
    my $abs_root = Cwd::realpath($root) // $root;

    my $self = bless {
        root          => $abs_root,
        default_type  => $args{default_type} // 'application/octet-stream',
        index         => $args{index} // ['index.html', 'index.htm'],
        handle_ranges => $args{handle_ranges} // 1,
    }, $class;
    return $self;
}

sub to_app {
    my ($self) = @_;

    my $root = $self->{root};

    return async sub  {
        my ($scope, $receive, $send) = @_;
        die "Unsupported scope type: $scope->{type}" if $scope->{type} ne 'http';

        my $method = uc($scope->{method} // '');
        unless ($method eq 'GET' || $method eq 'HEAD') {
            await $self->_send_error($send, 405, 'Method Not Allowed');
            return;
        }

        my $path = $scope->{path} // '/';

        # Security: Block null byte injection
        if ($path =~ /\0/) {
            await $self->_send_error($send, 400, 'Bad Request');
            return;
        }

        # Security: Normalize backslashes to forward slashes
        $path =~ s{\\}{/}g;

        # Security: Split path and validate each component
        # Use -1 limit to preserve trailing empty strings
        my @components = split m{/}, $path, -1;
        for my $component (@components) {
            # Block components with 2+ dots (.. , ..., ....)
            if ($component =~ /^\.{2,}$/) {
                await $self->_send_error($send, 403, 'Forbidden');
                return;
            }
            # Block hidden files (dotfiles) - components starting with .
            if ($component =~ /^\./ && $component ne '') {
                await $self->_send_error($send, 403, 'Forbidden');
                return;
            }
        }

        # Build file path using File::Spec for portability
        $path =~ s{^/+}{};
        my $file_path = File::Spec->catfile($root, $path);

        # Check for index files if directory
        if (-d $file_path) {
            for my $index (@{$self->{index}}) {
                my $index_path = File::Spec->catfile($file_path, $index);
                if (-f $index_path) {
                    $file_path = $index_path;
                    last;
                }
            }
        }

        unless (-f $file_path && -r $file_path) {
            await $self->_send_error($send, 404, 'Not Found');
            return;
        }

        # Security: Verify resolved path stays within root (prevents symlink escape)
        my $real_path = Cwd::realpath($file_path);
        unless ($real_path && index($real_path, $root) == 0) {
            await $self->_send_error($send, 403, 'Forbidden');
            return;
        }

        my @stat = stat($file_path);
        my $size = $stat[7];
        my $mtime = $stat[9];
        my $etag = '"' . md5_hex("$mtime-$size") . '"';

        # Check If-None-Match
        my $if_none_match = $self->_get_header($scope, 'if-none-match');
        if ($if_none_match && $if_none_match eq $etag) {
            await $send->({
                type => 'http.response.start',
                status => 304,
                headers => [['etag', $etag]],
            });
            await $send->({ type => 'http.response.body', body => '', more => 0 });
            return;
        }

        # Determine MIME type
        my ($ext) = $file_path =~ /\.([^.]+)$/;
        my $content_type = $MIME_TYPES{lc($ext // '')} // $self->{default_type};