view release on metacpan or  search on metacpan

script/lupa-pona  view on Meta::CPAN

    tls_cert => $cert_file,
    tls_key => $key_file,
  } => sub {
    my ($loop, $stream) = @_;
    $stream->on(read => \&serve_gemini);
  });

Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

sub serve_gemini {
  my ($stream, $url) = @_;
  return unless $url =~ s/\r\n.*//s; # needs URL and CR LF in one chunk
  my ($scheme, $authority, $path, $query, $fragment) =
      $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
  my ($url_host, $url_port) = split(/:/, $authority);
  $url_port ||= 1965;
  $log->info("Looking at $url");
  if (not $url) {
    $log->debug("The URL is empty");
    $stream->write("59 URL expected\r\n");
  } elsif (length($url) > 1024) {
    $log->debug("The URL is too long");
    $stream->write("59 The URL is too long\r\n");
  } elsif ($authority and $host and $host ne $url_host or $port ne $url_port) {
    $stream->write("53 Unsupported proxy request for $url; we just serve $host:$port\r\n");
  } elsif (not $path) {
    $stream->write("31 $url/\r\n"); # enforce trailing slash
  } elsif ($path eq "/") {
    $stream->write("20 text/gemini; charset=UTF-8\r\n");
    $stream->write("Welcome to Lupa Pona!\n");
    for (read_dir(".")) {
      next if $_ eq $cert_file;
      next if $_ eq $key_file;
      next if /~$/; # Emacs backup files
      $stream->write("=> $_\n") if -f;
    }
  } elsif ($path eq "/$cert_file" or $path eq "/$key_file") {
    $stream->write("50 Forbidden\n");
  } elsif ($path =~ m!^/([^/]+)$!) {
    my $file = decode_utf8(uri_unescape($1));
    if (-f $file) {
      my $mime = globs($file) || mime_type($file);
      $mime .= "; charset=$encoding" if $mime =~ /^text\// and $encoding;
      $stream->write("20 $mime\r\n");
      $stream->write(read_binary($file));
    } else {
      $stream->write("51 File not found: $file\r\n");
    }
  } else {
    $log->info("No handler for $url");
    $stream->write("59 Don't know how to handle $url\r\n");
  }
  $stream->close_gracefully();
};

sub mime_type {
  $_ = shift;
  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/gemini';
}