view release on metacpan or  search on metacpan

lib/App/Phoebe/StaticFiles.pm  view on Meta::CPAN

use App::Phoebe qw(@extensions $log host_regex port success result);
use Encode qw(encode_utf8 decode_utf8);
use URI::Escape;
use Mojo::File;

# add a code reference to the list of extensions
push(@extensions, \&static_routes);

# a hash mapping routes to the static directories to serve
our %routes;

sub static_routes {
  my ($stream, $url) = @_;
  my $host = host_regex();
  my $port = port($stream);
  if ($url =~ m!^gemini://($host)(?::$port)?/do/static/?$!) {
    $log->debug("Serving the list of static routes");
    success($stream);
    for my $route (sort keys %routes) {
      $stream->write("=> /do/static/" . uri_escape_utf8($route) . " " . encode_utf8($route) . "\n");
    }
    return 1;
  } elsif ($url =~ m!^gemini://($host)(?::$port)?/do/static/([^/]+)/?$!) {
    my $route = decode_utf8(uri_unescape($2));
    my $dir = $routes{$route};
    $log->debug("Serving list of files at $route, reading $dir");
    if ($dir) {
      success($stream);
      my @files = map { $_->basename } Mojo::File->new($dir)->list->each;
      for my $file (sort map { decode_utf8($_) } @files) {
	$stream->write("=> /do/static/" . uri_escape_utf8($route) . "/" . uri_escape_utf8($file)
		       . " " . encode_utf8($file) . "\n");
      }
    } else {
      result($stream, "40", "Unknown route: " . encode_utf8($route));
    }
    return 1;
  } elsif ($url =~ m!^gemini://($host)(?::$port)?/do/static/([^/]+)/([^.].*)$!i) {
    my $route = decode_utf8(uri_unescape($2));
    my $file = decode_utf8(uri_unescape($3));
    $log->debug("Serving $route/$file");
    my $dir = $routes{$route};
    return result($stream, "40", "Unknown route: " . encode_utf8($route))
	unless $dir;
    my $path = Mojo::File->new($dir, $file);
    return result($stream, "40", "Unknown file: " . encode_utf8($file))
	unless -f $path and is_in(Mojo::File->new($dir), $path);
    success($stream, mime_type($$path));
    $stream->write($path->slurp);
    return 1;
  }
  return;
}

# being paranoid about directory traversal
sub is_in {
  my ($parent, $child) = map { $_->to_abs } @_;
  return substr($child, 0, length($parent)) eq $parent;
}

# cheap MIME type guessing; alternatively, use File::MimeInfo
sub mime_type {
  $_ = shift;
  return 'text/gemini' if /\.gmi$/i;
  return 'text/plain' if /\.te?xt$/i;
  return 'text/markdown' if /\.md$/i;
  return 'text/html' if /\.html?$/i;
  return 'image/png' if /\.png$/i;
  return 'image/jpeg' if /\.jpe?g$/i;
  return 'image/gif' if /\.gif$/i;
  return 'text/plain'; # or application/octet-stream?
}

1;