view release on metacpan or  search on metacpan

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

    => /login Login

=cut

package App::Phoebe::Iapetus;
use App::Phoebe qw($server $log @request_handlers @extensions host_regex space_regex space port result
		   valid_id valid_mime_type valid_size @known_fingerprints process_titan);
use Modern::Perl;
use File::MimeInfo qw(globs);
use Encode qw(decode_utf8);
use URI::Escape;

push(@{$server->{wiki_mime_type}},'text/gemini');
unshift(@request_handlers, '^iapetus://' => \&handle_iapetus);

sub handle_iapetus {
  my $stream = shift;
  my $data = shift;
  # extra processing of the request if we didn't do that, yet
  return setup_iapetus($stream, $data) unless $data->{upload};
  my $size = $data->{upload}->{params}->{size};
  my $actual = length($data->{buffer});
  if ($actual == $size) {
    $log->debug("Handle Iapetus request as Titan request");
    process_titan($stream, $data->{request}, $data->{upload}, $data->{buffer}, $size);
    # do not close in case we're waiting for the lock
    return;
  } elsif ($actual > $size) {
    $log->debug("Received more than the promised $size bytes");
    result($stream, "59", "Received more than the promised $size bytes");
    $stream->close_gracefully();
    return;
  }
  $log->debug("Waiting for " . ($size - $actual) . " more bytes");
}

sub setup_iapetus {
  my $stream = shift;
  my $data = shift;
  my $request = $data->{request};
  $log->info("Looking at $request");
  my $hosts = host_regex();
  my $spaces_regex = space_regex();
  my $port = port($stream);
  if ($request =~ m!^iapetus://($hosts)(?::$port)?!) {
    my $host = $1;
    my($scheme, $authority, $path, $query, $fragment, $size) =
	$request =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(\S*))?\s+(\d+)|;
    if ($path =~ m!^(?:/($spaces_regex))?(?:/raw)?/([^/;=&]+)!) {
      my ($space, $id) = ($1, $2);
      return unless valid_id($stream, $host, $space, $id);
      my $type = globs($id) || mime_type($id);
      my $params = { size => $size, mime => $type };
      return unless valid_mime_type($stream, $host, $space, $id, $params);
      return unless valid_size($stream, $host, $space, $id, $params);
      return unless valid_client_cert($stream, $host, $space, $id, $params);
      $data->{upload} = {
	host => $host,
	space => space($stream, $host, $space),
	id => decode_utf8(uri_unescape($id)),
	params => $params,
      };
      result($stream, "10", "Continue"); # weird!
      return 1;
    } else {
      $log->debug("The path $path is malformed");
      result($stream, "59", "The path $path is malformed");
      $stream->close_gracefully();
    }
  }
  return 0;
}

# fallback if File::MimeInfo found no data files
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'; # this is what phoebe expects
}

# duplicates functionality from registered_editor_login.pl

sub valid_client_cert {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $fingerprint = $stream->handle->get_fingerprint();
  if ($fingerprint and grep { $_ eq $fingerprint} @known_fingerprints) {
    $log->info("Successfully identified client certificate");
    return 1;
  } elsif ($fingerprint) {
    $log->info("Unknown client certificate $fingerprint");
    result($stream, "61", "Your client certificate is not authorized for editing");
  } else {
    $log->info("Requested client certificate");
    result($stream, "60", "You need a client certificate to edit this wiki");
  }
  $stream->close_gracefully();
  return;
}

# also duplicates functionality from registered_editor_login.pl

push(@extensions, \&iapetus_login);

sub iapetus_login {
  my $stream = shift;
  my $url = shift;
  my $hosts = host_regex();
  my $spaces = space_regex();
  my $port = port($stream);
  my $fingerprint = $stream->handle->get_fingerprint();
  my $host;