view release on metacpan or  search on metacpan

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

always returns 1, so Phoebe considers this request handled. Therefore, the
regular request handlers won't get used. Make sure that any extensions you do
want to have are prepended to C<@extensions> after setting it (using
C<unshift>).

    # tested by t/example-capsules-only.t
    package App::Phoebe::Capsules;
    use Modern::Perl;
    use App::Phoebe qw($log @request_handlers @extensions);
    use App::Phoebe::Capsules;
    our $capsule_help = '//transjovian.org/phoebe/page/Capsules';
    our $capsule_space;
    @extensions = (\&capsules, \&nothing_else);
    sub nothing_else {
      my ($stream, $url) = @_;
      $log->info("No handler for $url: only capsules!");
      result($stream, "30", "/$capsule_space");
      1;
    }
    $log->info('Only capsules!');
    1;

=cut

package App::Phoebe::Capsules;
use App::Phoebe qw($server $log @extensions @request_handlers host_regex port success result print_link wiki_dir
		   valid_id valid_mime_type valid_size to_url);
use File::Slurper qw(read_dir read_binary write_binary);
use Net::IDN::Encode qw(domain_to_ascii);
use Encode qw(encode_utf8 decode_utf8);
use File::MimeInfo qw(globs);
use List::Util qw(sum first);
use Modern::Perl;
use URI::Escape;

push(@extensions, \&capsules);

our $capsule_space = "capsule";
our @capsule_hosts;
our $capsule_help;
our @capsule_tokens;
our %capsule_equivalent;

# load fingerprint equivalents on the next tick
Mojo::IOLoop->next_tick(sub {
  my $dir = $server->{wiki_dir};
  if (-f "$dir/fingerprint_equivalents") {
    my $bytes = read_binary("$dir/fingerprint_equivalents");
    %capsule_equivalent = split(' ', $bytes);
  } } );

sub capsules {
  my $stream = shift;
  my $url = shift;
  my $hosts = capsule_regex();
  my $port = port($stream);
  my ($host, $capsule, $id, $token);
  if ($url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/upload$!) {
    return result($stream, "10", "Filename");
  } elsif (($host, $capsule, $id) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/upload\?([^/]+)$!) {
    $capsule = decode_utf8(uri_unescape($capsule));
    return result($stream, "30", "gemini://$host:$port/$capsule_space/$capsule/$id");
  } elsif (($host) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/login$!) {
    return serve_capsule_login($stream, $host);
  } elsif (($host, $capsule) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/archive$!) {
    return serve_capsule_archive($stream, $host, decode_utf8(uri_unescape($capsule)));
  } elsif (($host, $capsule, $id) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/backup(?:/([^/]+))?$!) {
    return serve_capsule_backup($stream, $host, map { decode_utf8(uri_unescape($_)) } $capsule, $id||"");
  } elsif (($host, $capsule, $id) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/delete(?:/([^/]+))?$!) {
    return serve_capsule_delete($stream, $host, map { decode_utf8(uri_unescape($_)) } $capsule, $id||"");
  } elsif ($url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/access$!) {
    return result($stream, "10", "Password");
  } elsif (($host, $capsule, $token) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/access\?(.+)$!) {
    return serve_capsule_access($stream, $host, decode_utf8(uri_unescape($capsule)), decode_utf8(uri_unescape($token)));
  } elsif (($host, $capsule) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/share$!) {
    return serve_capsule_sharing($stream, $host, decode_utf8(uri_unescape($capsule)));
  } elsif (($host, $capsule, $id) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/([^/]+)$!) {
    return serve_capsule_page($stream, $host, map { decode_utf8(uri_unescape($_)) } $capsule, $id);
  } elsif (($host, $capsule) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/([^/]+)/?$!) {
    return serve_capsule_menu($stream, $host, decode_utf8(uri_unescape($capsule)));
  } elsif (($host) = $url =~ m!^gemini://($hosts)(?::$port)?/$capsule_space/?$!) {
    return serve_main_menu($stream, $host);
  }
  return;
}

sub serve_capsule_login {
  my ($stream, $host) = @_;
  my $name = capsule_name($stream);
  if ($name) {
    $log->info("Redirect to capsule");
    result($stream, "30", to_url($stream, $host, $capsule_space, ""));
  } else {
    $log->info("Requested client certificate for capsule");
    result($stream, "60", "You need a client certificate to access your capsule");
  }
  return 1;
}

sub serve_capsule_archive {
  my ($stream, $host, $capsule) = @_;
  my $name = capsule_name($stream);
  return 1 unless is_my_capsule($stream, $name, $capsule, 'archive');
  # use /bin/tar instead of Archive::Tar to save memory
  my $dir = wiki_dir($host, $capsule_space) . "/" . encode_utf8($capsule);
  my $file = "$dir/backup/data.tar.gz";
  if (-e $file and time() - modified($file) <= 300) { # data is valid for 5 minutes
    $log->info("Serving cached data archive for $capsule");
    success($stream, "application/tar");
    $stream->write(read_binary($file));
  } else {
    write_binary($file, ""); # truncate in order to avoid "file changed as we read it" warning
    my @command = ('/bin/tar', '--create', '--gzip',
		   '--file', $file,
		   '--exclude', "backup",
		   '--directory', "$dir/..",
		   encode_utf8($capsule));
    $log->debug("@command");
    if (system(@command) == 0) {
      $log->info("Serving new data archive for $capsule");
      success($stream, "application/tar");
      $stream->write(read_binary($file));
    } else {
      $log->error("Creation of data archive for $capsule failed");
      result($stream, "59", "Archive creation failed");
    }
  }
  return 1;
}

sub serve_capsule_backup {
  my ($stream, $host, $capsule, $id) = @_;
  my $name = capsule_name($stream);
  return 1 unless is_my_capsule($stream, $name, $capsule, 'view the backup of');
  my $dir = capsule_dir($host, $capsule) . "/backup";
  if ($id) {
    $log->info("Serving $capsule backup $id");
    # this works for text files, too!
    success($stream, mime_type($id));
    my $file = $dir . "/" . encode_utf8($id);

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

	if $n <= 3 or $longname;
  }
  $name =~ s/\.//g;
  return $name;
}

sub mime_type {
  $_ = shift;
  my $mime = globs($_);
  return $mime if $mime;
  # fallback
  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 'application/octet-stream';
}

sub capsule_token_cleanup {
  # only keep tokens created in the last 10 minutes
  my $ts = time - 600;
  @capsule_tokens = grep { $_->[0] > $ts } @capsule_tokens;
}

unshift(@request_handlers, '^titan://(' . capsule_regex() . ')(?::\d+)?/' . $capsule_space . '/' => \&handle_titan);

# We need our own Titan handler because we want a different copy of is_upload;
# and once we're here we can run our extension directly.
sub handle_titan {
  my $stream = shift;
  my $data = shift;
  # extra processing of the request if we didn't do that, yet
  $data->{upload} ||= is_upload($stream, $data->{request}) or return;
  my $size = $data->{upload}->{params}->{size};
  my $actual = length($data->{buffer});
  if ($actual == $size) {
    save_file($stream, $data->{request}, $data->{upload}, $data->{buffer}, $size);
    $stream->close_gracefully();
    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");
}

# We need our own is_upload because the regular expression is different.
sub is_upload {
  my $stream = shift;
  my $request = shift;
  $log->info("Looking at capsule $request");
  my $hosts = capsule_regex();
  my $port = port($stream);
  if ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+);([^?#]+)$!) {
    my $host = $1;
    my ($capsule, $id, %params) = map {decode_utf8(uri_unescape($_))} $2, $3, split(/[;=&]/, $4);
    if (valid_params($stream, $host, $capsule_space, $id, \%params)) {
      return {
	host => $host,
	space => $capsule_space,
	capsule => $capsule,
	id => $id,
	params => \%params,
      }
    }
    # valid_params printed a response and closed the stream
    return;
  }
  $log->debug("Capsule upload with malformed titan URL");
  if ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+);([^?#]*)[?#]!) {
    result($stream, "59", "The titan URL must not have a query or a fragment at the end");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+)/!) {
    result($stream, "59", "These capsules do not allow uploads for subdirectories");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+)$!) {
    result($stream, "59", "The titan URL is missing the parameters after a semikolon $1 $2 $3 $4");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/?(;.*)$!) {
    result($stream, "59", "The titan URL is missing the file name");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/?$!) {
    result($stream, "59", "The titan URL is missing the capsule name and the file name");
  } else {
    result($stream, "59", "The titan URL is malformed");
  }
  $stream->close_gracefully();
  return;
}

# We need our own valid_params because we don't check the token but we do check
# the extension
sub valid_params {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $params = shift;
  return unless valid_id($stream, $host, $space, $id, $params);
  # return unless valid_token($stream, $host, $space, $id, $params);
  $params->{mime} = mime_type($id);
  return unless valid_mime_type($stream, $host, $space, $id, $params);
  return unless valid_size($stream, $host, $space, $id, $params);
  return 1;
}

sub save_file {
  my ($stream, $url, $upload, $buffer, $size) = @_;
  my $name = capsule_name($stream);
  my $capsule = $upload->{capsule} || "";
  if (not $name) {
    $log->debug("Missing certificate for capsule upload");
    return result($stream, "60", "Uploading files requires a client certificate");
  } elsif ($name ne $capsule) {
    $log->debug("Wrong certificate for capsule upload: $name vs $capsule");
    return result($stream, "61", "This is not your space: your certificate authorizes you for $name");
  }
  return result($stream, "50", "Titan upload failed")
      unless defined $buffer and defined $size and $upload->{id}
      and $upload->{space} and $upload->{space} eq "capsule";