view release on metacpan or  search on metacpan

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

    success($stream);
    $stream->write("This file does not exist. Upload it using Titan!\n");
    $stream->write("=> gemini://transjovian.org/titan What is Titan?\n");
  }
  return 1;
}

sub serve_capsule_menu {
  my ($stream, $host, $capsule) = @_;
  my $name = capsule_name($stream);
  my $dir = capsule_dir($host, $capsule);
  my @files;
  @files = read_dir($dir) if -d $dir;
  my $has_backup = first { $_ eq "backup" } @files;
  @files = grep { $_ ne "backup" } @files if $has_backup;
  success($stream);
  $log->info("Serving $capsule");
  $stream->write("# " . ucfirst($capsule) . "\n");
  if ($name) {
    if ($name eq $capsule) {
      print_link($stream, $host, $capsule_space, "Specify file for upload", "$capsule/upload");
      print_link($stream, $host, $capsule_space, "Delete file", "$capsule/delete") if @files;
      print_link($stream, $host, $capsule_space, "Share access with other people or other devices", "$capsule/share");
      print_link($stream, $host, $capsule_space, "Access backup", "$capsule/backup") if $has_backup;
      print_link($stream, $host, $capsule_space, "Download archive", "$capsule/archive") if @files;
    } elsif (@capsule_tokens) {
      print_link($stream, $host, $capsule_space, "Access this capsule", "$capsule/access");
    }
  }
  if (@files) {
    $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;