File Coverage

blib/lib/PAGI/App/Directory.pm

Criterion	Covered	Total	%
statement	109	115	94.7
branch	34	38	89.4
condition	12	22	54.5
subroutine	14	14	100.0
pod	0	2	0.0
total	169	191	88.4

package PAGI::App::Directory;

use strict;
use warnings;
use Future::AsyncAwait;
use parent 'PAGI::App::File';
use JSON::MaybeXS ();
use File::Spec;
use Cwd qw(realpath);

=head1 NAME

PAGI::App::Directory - Serve files with directory listing

=head1 SYNOPSIS

    use PAGI::App::Directory;

    my $app = PAGI::App::Directory->new(
        root => '/var/www/files',
    )->to_app;

=cut

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

    my $self = $class->SUPER::new(%args);
    $self->{show_hidden} = $args{show_hidden} // 0;
    # Cache realpath of root for symlink escape detection
    $self->{real_root} = realpath($self->{root}) // $self->{root};
    return $self;
}

# HTML escape to prevent XSS
sub _html_escape {
    my $str = shift;
    return '' unless defined $str;
    $str =~ s/&/&/g;
    $str =~ s/
    $str =~ s/>/>/g;
    $str =~ s/"/"/g;
    $str =~ s/'/'/g;
    return $str;
}

# URL encode for href attributes
sub _url_encode {
    my $str = shift;
    return '' unless defined $str;
    $str =~ s/([^A-Za-z0-9\-_.~\/])/sprintf("%%%02X", ord($1))/ge;
    return $str;
}

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

    my $parent_app = $self->SUPER::to_app();
    my $root = $self->{root};
    my $real_root = $self->{real_root};

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

        my $path = $scope->{path} // '/';
        $path =~ s{^/+}{};
        my $dir_path = File::Spec->catdir($root, $path);

        # Symlink escape check: ensure resolved path is within root
        my $real_dir = realpath($dir_path);
        if (!$real_dir || index($real_dir, $real_root) != 0) {
            await $self->_send_error($send, 403, 'Forbidden');
            return;
        }

        # If it's a directory without index file, show listing
        if (-d $dir_path) {
            my $has_index = 0;
            for my $index (@{$self->{index}}) {
                if (-f File::Spec->catfile($dir_path, $index)) {
                    $has_index = 1;
                    last;
                }
            }

            unless ($has_index) {
                await $self->_send_listing($send, $scope, $dir_path, $path);
                return;
            }
        }

        # Fall back to parent file serving
        await $parent_app->($scope, $receive, $send);
    };
}

async sub _send_listing {
    my ($self, $send, $scope, $dir_path, $rel_path) = @_;

    opendir my $dh, $dir_path or do {
        await $self->_send_error($send, 403, 'Forbidden');
        return;
    };

    my @entries;
    while (my $entry = readdir $dh) {
        next if $entry eq '.';
        next if !$self->{show_hidden} && $entry =~ /^\./;

        my $full_path = File::Spec->catfile($dir_path, $entry);
        my @stat = stat($full_path);
        push @entries, {
            name  => $entry,
            is_dir => -d $full_path ? 1 : 0,
            size  => $stat[7] // 0,
            mtime => $stat[9] // 0,
        };
    }
    closedir $dh;

    # Sort directories first, then by name
    @entries = sort { $b->{is_dir} <=> $a->{is_dir} || $a->{name} cmp $b->{name} } @entries;

    # Check Accept header for JSON
    my $accept = $self->_get_header($scope, 'accept') // '';
    if ($accept =~ m{application/json}) {
        my $json = JSON::MaybeXS::encode_json(\@entries);
        await $send->({
            type => 'http.response.start',
            status => 200,
            headers => [['content-type', 'application/json'], ['content-length', length($json)]],
        });
        await $send->({ type => 'http.response.body', body => $json, more => 0 });
        return;
    }

    # HTML listing
    my $base_path = $rel_path eq '' ? '/' : "/$rel_path";
    $base_path =~ s{/+$}{};

    # Escape base_path for safe HTML output
    my $escaped_path = _html_escape($base_path);

    my $html = "Index of $escaped_path/";
    $html .= 'body{font-family:sans-serif;margin:20px}table{border-collapse:collapse}'; </td>
</tr>

<tr>
<td  class="h" >
<a name="147">147</a>
</td>

<td  class="c3" >

2

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

36

</td>

<td class="s">     $html .= 'th,td{padding:8px 16px;text-align:left;border-bottom:1px solid #ddd}'; </td>
</tr>

<tr>
<td  class="h" >
<a name="148">148</a>
</td>

<td  class="c3" >

2

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

3

</td>

<td class="s">     $html .= 'a{text-decoration:none;color:#0066cc}a:hover{text-decoration:underline}';
    $html .= "Index of $escaped_path/"; '; }; NameSize




150




 





 





 





 





 





 



   




151




2




  
100
  




 





 





 





7



     if ($rel_path ne '') { 




152




1





 





 





 





 





2



         $html .= '..-




153




 





 





 





 





 





 



     } 




154




 





 





 





 





 





 



   




155




2





 





 





 





 





5



     for my $entry (@entries) { 




156




4





 





 





 





 





9



         my $name = $entry->{name}; 




157




4




  
100
  




 





 





 





8



         my $display = $entry->{is_dir} ? "$name/" : $name; 




158




4




  
100
  




 





 





 





10



         my $href = "$name" . ($entry->{is_dir} ? '/' : ''); 




159




4




  
100
  




 





 





 





11



         my $size = $entry->{is_dir} ? '-' : _format_size($entry->{size}); 




160




 





 





 





 





 





 



   




161




 





 





 





 





 





 



         # Escape all user-controlled values to prevent XSS 




162




4





 





 





 





 





9



         my $escaped_display = _html_escape($display); 




163




4





 





 





 





 





10



         my $escaped_href = _html_escape(_url_encode($href)); 




164




4





 





 





 





 





9



         $html .= qq{$escaped_display$size




165




 





 





 





 





 





 



     } 




166




 





 





 





 





 





 



   




167




2





 





 





 





 





4



     $html .= '';

    if ($rel_path ne '') {
        $html .= '
    }

    for my $entry (@entries) {
        my $name = $entry->{name};
        my $display = $entry->{is_dir} ? "$name/" : $name;
        my $href = "$name" . ($entry->{is_dir} ? '/' : '');
        my $size = $entry->{is_dir} ? '-' : _format_size($entry->{size});

        # Escape all user-controlled values to prevent XSS
        my $escaped_display = _html_escape($display);
        my $escaped_href = _html_escape(_url_encode($href));
        $html .= qq{
    }

    $html .= '

    await $send->({
        type => 'http.response.start',
        status => 200,
        headers => [['content-type', 'text/html'], ['content-length', length($html)]],
    });
    await $send->({ type => 'http.response.body', body => $html, more => 0 });
}

sub _format_size {
    my $size = shift;
    return '0' if $size == 0;
    my @units = qw(B KB MB GB);
    my $i = 0;
    while ($size >= 1024 && $i < $#units) {
        $size /= 1024;
        $i++;
    }
    return sprintf("%.1f %s", $size, $units[$i]);
}

1;

__END__