File Coverage

blib/lib/POE/Component/Server/HTTPServer/StaticHandler.pm

Criterion	Covered	Total	%
statement	15	76	19.7
branch	0	24	0.0
condition			n/a
subroutine	5	9	55.5
pod	3	3	100.0
total	23	112	20.5

package POE::Component::Server::HTTPServer::StaticHandler;
use strict;
use HTTP::Status;
use MIME::Types;
use POE::Component::Server::HTTPServer::Handler;
use base 'POE::Component::Server::HTTPServer::Handler';

# _init( $root [, index_file => $index_file] [, auto_index => $auto_index ] )
#    Files will be served relative to $root
#    If a request is made for a directory, then:
#      If $index_file is defined and found, it will be returned.
#      Else, if $auto_index is defined, a directory index will be generated.
#    Otherwise, this handler will pass on the request.
sub _init {
  my $self = shift;
  my $root = shift;
  my %args = @_;
  $self->{root} = $root;
  $self->{mimetypes} = MIME::Types->new(); # ugh
  if ( exists($args{index_file}) ) {
    $self->{index_file} = $args{index_file};
  } else {
    $self->{index_file} = 'index.html';
  }
  if ( exists($args{auto_index}) ) {
    $self->{auto_index} = $args{auto_index};
  } else {
    $self->{auto_index} = 0;
  }
}

sub handle {
  my $self = shift;
  my $context = shift;
  #print "Handling static request (", __PACKAGE__, ")\n";
  my $cpath = $context->{contextpath};
  #print "Context path=$cpath\n";
  # scrub path (badly): XXX fix this with file::spec or the like
  if ( $cpath =~ m[(^|/)\.\.(/|$)] ) {
    warn "Will not serve dangerous path '$cpath'\n"; # should keep silent here
    return H_CONT;
  }
  my $filepath = "$self->{root}/$cpath";
  #print "static root: $filepath\n";
  if ( -d $filepath ) {
    return $self->handle_directory($filepath, $context);
  } elsif ( -f $filepath ) {
    return $self->handle_plainfile($filepath, $context);
  } else {
    #print "Request for non-existant file: $filepath\n";
    return H_CONT;
  }
}

sub handle_plainfile {
  my $self = shift;
  my $filepath = shift;
  my $context = shift;
  if ( open(my $in, $filepath) ) {
    binmode($in);
    local $/ = undef;
    $context->{response}->code( RC_OK );
    my $type = $self->{mimetypes}->mimeTypeOf( $filepath );
    $type='text/plain' unless defined($type);
    $context->{response}->content_type( $type );
    $context->{response}->content(<$in>);
    return H_FINAL;
  } else {
    #print "Failed to open $filepath ($!)\n";
    $context->{error_message} = $!; # XXX security: returned with 404 response
    return H_CONT;
  }
}

sub handle_directory {
  my $self = shift;
  my $filepath = shift;
  my $context = shift;
  #print "directory( $filepath )\n";
  if ( $self->{index_file} ) {
    my $index_file = "$filepath/$self->{index_file}";
    if ( -e $index_file ) {
      return $self->handle_plainfile( $index_file, $context );
    }
  }
  if ( $self->{auto_index} ) {
    # nasty hack: should probably just not include this option
    if ( opendir(my $dir, $filepath) ) {
      my $page = qq{Directory Index\n};
      $page .= qq{\n};
      $page .= qq{Directory Index\n};
      $page .= qq{\n};
      my $base = $context->{request}->uri;
      while(my $fn = readdir($dir)) {
	next if $fn=~/^\./;
	$page .= qq{$fn\n};
      }
      $page .= qq{\n};
      $page .= qq{\n};
      $context->{response}->code( RC_OK );
      $context->{response}->content( $page );
      return H_FINAL;
    } else {
      # XXX should this class of problem be a 500?
      #print "Failed to opendir ($!)\n";
      $context->{error_message} = $!; # XXX security: returned with 404 resp
      return H_CONT;
    }
  }
  return H_CONT;
}

1;
__END__