view release on metacpan or  search on metacpan

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

    $stream->write("Files:\n");
    for my $file (sort @files) {
      print_link($stream, $host, $capsule_space, $file, "$capsule/$file");
    }
  }
  return 1;
}

sub serve_main_menu {
  my ($stream, $host) = @_;
  success($stream);
  $log->info("Serving capsules");
  $stream->write("# Capsules\n");
  my $capsule = capsule_name($stream);
  if ($capsule) {
    $stream->write("This is your capsule:\n");
    print_link($stream, $host, $capsule_space, $capsule, $capsule); # must provide $id to avoid page/ prefix
  } else {
    $stream->write("Login if you are interested in a capsule:\n");
    print_link($stream, $host, $capsule_space, "login", "login"); # must provide $id to avoid page/ prefix
  }
  $stream->write("=> $capsule_help Help\n") if $capsule_help;
  my @capsules = read_dir(wiki_dir($host, $capsule_space));
  $stream->write("Capsules:\n") if @capsules;
  for my $dir (sort @capsules) {
    print_link($stream, $host, $capsule_space, $dir, $dir); # must provide $id to avoid page/ prefix
  };
  return 1;
}

# capsule is already decoded and gets encoded again
sub capsule_dir {
  my $host = shift;
  my $capsule = shift;
  my $dir = $server->{wiki_dir};
  if (keys %{$server->{host}} > 1) {
    $dir .= "/$host";
    mkdir($dir) unless -d $dir;
  }
  $dir .= "/$capsule_space";
  mkdir($dir) unless -d $dir;
  $dir .= "/" . encode_utf8($capsule);
  return $dir;
}

sub capsule_regex {
  return join("|", map { quotemeta domain_to_ascii $_ } @capsule_hosts) || host_regex();
}

# For 'sha256$5a4a0248b753' the name is tibedied (the first name for Elite names)
sub capsule_name {
  my $stream = shift;
  # $stream can be a fingerprint string
  my $fingerprint = ref $stream ? $stream->handle->get_fingerprint() : $stream;
  return unless $fingerprint;
  $fingerprint = $capsule_equivalent{$fingerprint} if $capsule_equivalent{$fingerprint};
  my @stack = map { hex } substr($fingerprint, 7, 12) =~ /(....)/g;
  my $digraphs = "..lexegezacebisousesarmaindirea.eratenberalavetiedorquanteisrion";
  my $longname = $stack[0] & 0x40;
  my $name;
  # say "@stack";
  for my $n (1 .. 4) {
    my $d = (($stack[2] >> 8) & 0x1f) << 1;
    push(@stack, sum(@stack) % 0x10000);
    shift(@stack);
    $name .= substr($digraphs, $d, 2)
	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;