App-Phoebe
view release on metacpan or search on metacpan
If you are not using `cpan` or `cpanm` to install Phoebe, you'll need to install
the following dependencies:
- [Algorithm::Diff](https://metacpan.org/pod/Algorithm%3A%3ADiff), or `libalgorithm-diff-xs-perl`
- [File::ReadBackwards](https://metacpan.org/pod/File%3A%3AReadBackwards), or `libfile-readbackwards-perl`
- [File::Slurper](https://metacpan.org/pod/File%3A%3ASlurper), or `libfile-slurper-perl`
- [Mojolicious](https://metacpan.org/pod/Mojolicious), or `libmojolicious-perl`
- [IO::Socket::SSL](https://metacpan.org/pod/IO%3A%3ASocket%3A%3ASSL), or `libio-socket-ssl-perl`
- [Modern::Perl](https://metacpan.org/pod/Modern%3A%3APerl), or `libmodern-perl-perl`
- [URI::Escape](https://metacpan.org/pod/URI%3A%3AEscape), or `liburi-escape-xs-perl`
- [Net::IDN::Encode](https://metacpan.org/pod/Net%3A%3AIDN%3A%3AEncode), or `libnet-idn-encode-perl`
- [Encode::Locale](https://metacpan.org/pod/Encode%3A%3ALocale), or `libencode-locale-perl`
I'm going to be using `curl` and `openssl` in the Quickstart section of
`phoebe`, so you'll need those tools as well. And finally, when people download
their data, the code calls `tar` (available from packages with the same name on
Debian derived systems).
## Installing Perl
lib/App/Phoebe.pm view on Meta::CPAN
serve_blog_rss($stream, $host, space($stream, $host, $space));
} elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/atom$!) {
serve_atom($stream, $host, space($stream, $host, $space));
} elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/blog/atom$!) {
serve_blog_atom($stream, $host);
} elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/all/atom$!) {
serve_all_atom($stream, $host);
} elsif (($host) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?/robots.txt(?:[#?].*)?$!) {
serve_raw($stream, $host, undef, "robots");
} elsif (($host, $space, $id, $n, $style) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/history/([^/]*)(?:/(\d+))?(?:/(colour|fancy))?$!) {
serve_history($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10, $style);
} elsif (($host, $space, $id, $n, $style) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/diff/([^/]*)(?:/(\d+))?(?:/(colour))?$!) {
serve_diff($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n, $style);
} elsif (($host, $space, $id, $n) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/raw/([^/]*)(?:/(\d+))?$!) {
serve_raw($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif (($host, $space, $id, $n) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/html/([^/]*)(?:/(\d+))?$!) {
serve_html($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif (($host, $space, $id, $n) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/page/([^/]+)(?:/(\d+))?$!) {
serve_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif (($host, $space, $id) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/file/([^/]+)?$!) {
serve_file($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
} elsif (($host) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(/|$)!) {
$log->info("Unknown path for $url\r");
result($stream, "51", "Path not found for $url");
} elsif ($authority) {
$log->info("Unsupported proxy request for $url");
result($stream, "53", "Unsupported proxy request for $url");
} else {
$log->info("No handler for $url");
result($stream, "59", "Don't know how to handle $url");
}
$log->debug("Done");
};
$log->error("Error: $@") if $@;
alarm(0);
$stream->close_gracefully();
}
sub decode_query {
my $query = shift;
return $query unless $query;
$query = decode_utf8(uri_unescape($query));
$query =~ s/\+/ /g;
return $query;
}
sub run_extensions {
foreach my $sub (@extensions) {
return 1 if $sub->(@_);
}
return;
}
lib/App/Phoebe.pm view on Meta::CPAN
sub to_url {
my $stream = shift;
my $host = lc shift;
my $space = shift;
my $id = shift;
my $scheme = shift || "gemini";
my $port = port($stream);
if ($space) {
$space = "" if $space eq $host;
$space =~ s/.*\///;
$space = uri_escape_utf8($space);
}
# don't encode the slash
return "$scheme://$host:$port/"
. ($space ? "$space/" : "")
. join("/", map { uri_escape_utf8($_) } split (/\//, $id));
}
sub gemini_link {
my $stream = shift;
my $host = shift;
my $space = shift;
my $title = shift;
my $id = shift;
if (not $id) {
$id = "page/$title";
lib/App/Phoebe.pm view on Meta::CPAN
READ:
return unless $_ = decode_utf8($fh->readline);
chomp;
my ($ts, $id_log, $revision, $code) = split(/\x1f/);
goto READ if $id_log ne $id;
$ts, $id_log, $revision, $code, $host, $space, 0 },
undef, #$kept
undef, #$filter
$style);
$stream->write("\n");
print_link($stream, $host, $space, "More...", "history/" . uri_escape_utf8($id) . "/" . 10 * $n . ($style ? "/$style" : ""));
}
sub footer {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift||"";
my @links;
push(@links, gemini_link($stream, $host, $space, "History", "history/$id"));
lib/App/Phoebe.pm view on Meta::CPAN
mkdir($dir) unless -d $dir;
return $dir;
}
# If we are serving multiple hostnames, we need to check whether the space
# supplied in the URL matches a known hostname/space combo.
sub space {
my $stream = shift;
my $host = shift;
my $space = shift;
$space = decode_utf8(uri_unescape($space)) if $space;
if (keys %{$server->{host}} > 1) {
return undef unless $space;
return $space if grep { $_ eq "$host/$space" } @{$server->{wiki_space}};
# else it's an error and we jump out to the eval {} in handle_url
result($stream, "40", "$host doesn't know about $space");
die "unknown space: $host/$space\n"; # is caught in the eval
}
# Without wildcards, just return the space. We already know that the space
# matched the regular expression of spaces.
return $space;
lib/App/Phoebe.pm view on Meta::CPAN
my $hosts = host_regex();
my $spaces_regex = space_regex();
my $port = port($stream);
if ($request =~ m!^titan://($hosts)(?::$port)?!) {
my $host = $1;
my($scheme, $authority, $path, $query, $fragment) =
$request =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
if ($path =~ m!^(?:/($spaces_regex))?(?:/raw|/page|/file)?/([^/;=&]+(?:;\w+=[^;=&]+)+)!) {
my $space = $1;
my ($id, @params) = split(/[;=&]/, $2);
my $params = { map {decode_utf8(uri_unescape($_))} @params };
if (valid_params($stream, $host, $space, $id, $params)) {
return {
host => $host,
space => space($stream, $host, $space),
id => decode_utf8(uri_unescape($id)),
params => $params,
}
}
} else {
$log->debug("The path $path is malformed");
result($stream, "59", "The path $path is malformed");
$stream->close_gracefully();
}
}
return 0;
lib/App/Phoebe/Capsules.pm view on Meta::CPAN
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) {
lib/App/Phoebe/Capsules.pm view on Meta::CPAN
# 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
lib/App/Phoebe/Chat.pm view on Meta::CPAN
}
my @found = grep { $host eq $_->{host} and $space eq $_->{space} and $name eq $_->{name} } @chat_members;
if (not @found) {
result($stream, "40", "You need to join the chat before you can say anything");
return;
}
if (not $text) {
result($stream, "10", encode_utf8 "Post to the channel as $name");
return;
}
$text = decode_utf8(uri_unescape($text));
unshift(@chat_lines, { host => $host, space => $space, name => $name, text => $text });
splice(@chat_lines, $chat_line_limit); # trim length of history
# send message
for (@chat_members) {
next unless $host eq $_->{host} and $space eq $_->{space};
$_->{stream}->write(encode_utf8 "$name: $text\n");
}
# and ask to send another one
result($stream, "31", "gemini://$host:$port" . ($space ? "/$space" : "") . "/do/chat/say");
return;
lib/App/Phoebe/Comments.pm view on Meta::CPAN
use URI::Escape;
use File::Slurper qw(read_text);
use utf8;
push(@footer, \&add_comment_link_to_footer);
sub add_comment_link_to_footer {
my ($stream, $host, $space, $id, $revision, $scheme) = @_;
# only leave comments on current comment pages
return "" if $revision;
$space = "/" . uri_escape_utf8($space) if $space;
$space //= "";
return "=> $space/page/" . uri_escape_utf8("Comments on $id") . " Comments" if $id !~ /^Comments on /;
return "=> $space/do/comment/" . uri_escape_utf8($id) . " Leave a short comment" if $scheme eq "gemini";
}
push(@extensions, \&process_comment_requests);
sub process_comment_requests {
my ($stream, $url) = @_;
my $hosts = host_regex();
my $spaces = space_regex();
my $port = port($stream);
my ($host, $space, $id, $token, $query);
lib/App/Phoebe/Comments.pm view on Meta::CPAN
$url =~ m!^gemini://($hosts)(?::$port)?(?:/($spaces))?/do/comment/([^/#?]+)\?([^#]+)!) {
if ($space) {
result($stream, "30", "gemini://$host:$port/$space/do/comment/$id/$token");
} else {
result($stream, "30", "gemini://$host:$port/do/comment/$id/$token");
}
} elsif ($url =~ m!^gemini://($hosts)(?::$port)?(?:/($spaces))?/do/comment/([^/#?]+)/([^/#?]+)$!) {
result($stream, "10", "Short comment");
} elsif (($host, $space, $id, $token, $query) = $url =~ m!^gemini://($hosts)(?::$port)?(?:/($spaces))?/do/comment/([^/#?]+)/([^/#?]+)\?([^#]+)!) {
append_comment($stream, $host, space($host, $space),
decode_utf8(uri_unescape($id)),
decode_utf8(uri_unescape($token)),
decode_query($query));
} else {
return 0;
}
return 1;
}
sub append_comment {
my ($stream, $host, $space, $id, $token, $query) = @_;
return if not valid_id($stream, $host, $space, $id);
lib/App/Phoebe/Galleries.pm view on Meta::CPAN
use App::Phoebe::Galleries;
=cut
package App::Phoebe::Galleries;
use App::Phoebe qw(@extensions $log port success result print_link);
use File::Slurper qw(read_dir read_binary read_text);
use Encode qw(decode_utf8 encode_utf8);
use Modern::Perl;
use Mojo::JSON qw(decode_json encode_json);
use Mojo::Util qw(url_unescape);
# galleries
push(@extensions, \&galleries);
our $galleries_dir = "/home/alex/alexschroeder.ch/gallery";
our $galleries_host = "alexschroeder.ch";
sub gallery_title {
my $dir = shift;
lib/App/Phoebe/Galleries.pm view on Meta::CPAN
$stream->write(encode_utf8 "# " . gallery_title($dir) . "\n");
}
for my $image (@{$data->{data}}) {
$stream->write("\n");
$stream->write(encode_utf8 join("\n", grep /\S/, @{$image->{caption}}) . "\n") if $image->{caption};
gallery_print_link($stream, $host, "Thumbnail", "do/gallery/$dir/" . $image->{thumb}->[0]);
gallery_print_link($stream, $host, "Image", "do/gallery/$dir/" . $image->{img}->[0]);
}
return 1;
} elsif (my ($file, $extension) = $url =~ m!^gemini://$host(?::$port)?/do/gallery/([^/?]*/(?:thumbs|imgs)/[^/?]*\.(jpe?g|png))$!i) {
$file = url_unescape $file; # do not decode UTF-8
my $name = decode_utf8($file);
if (not -r "$galleries_dir/$file") {
$stream->write(encode_utf8 "40 Cannot read $name\r\n");
} else {
success($stream, $extension =~ /^png$/i ? "image/png" : "image/jpeg");
$log->info("Serving image $name");
$stream->write(read_binary("$galleries_dir/$file"));
}
return 1;
}
lib/App/Phoebe/Gopher.pm view on Meta::CPAN
our $gophers_port = 7443; # listen on port 7443 using TLS
our $gopher_main_page = "Gopher_Welcome";
our @extensions;
push(@extensions, \&finger);
sub finger {
my $stream = shift;
my $selector = shift;
my $port = port($stream);
if ($port == 79 and $selector =~ m!^[^/]+$!) {
$log->debug("Serving $selector via finger");
gopher_serve_page($stream, $gopher_host, undef, decode_utf8(uri_unescape($selector)));
return 1;
}
return 0;
}
use App::Phoebe::Gopher;
=cut
package App::Phoebe::Gopher;
use App::Phoebe qw(get_ip_numbers $log $server @extensions port space pages blog_pages
lib/App/Phoebe/Gopher.pm view on Meta::CPAN
gopher_main_menu($stream, $host, space($stream, $host, $space));
} elsif (($space, $n) = $selector =~ m!^(?:($spaces)/)?do/more(?:/(\d+))?$!) {
gopher_serve_blog($stream, $host, space($stream, $host, $space), $n);
} elsif (($space) = $selector =~ m!^(?:($spaces)/)?do/index$!) {
gopher_serve_index($stream, $host, space($stream, $host, $space));
} elsif ($selector =~ m!^do/source$!) {
seek DATA, 0, 0;
local $/ = undef; # slurp
$stream->write(encode_utf8 <DATA>);
} elsif (($space, $query) = $selector =~ m!^(?:($spaces)/)?do/match\t(.+)!) {
gopher_serve_match($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($query)));
} elsif (($space, $query) = $selector =~ m!^(?:($spaces)/)?do/search\t(.+)!) {
gopher_serve_search($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($query)));
} elsif (($space, $id, $n) = $selector =~ m!^(?:($spaces)/)?(?:page/)?([^/]+)(?:/(\d+))?$!) {
# the /page is optional: makes finger possible
gopher_serve_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} else {
$log->info("No handler for $selector via gopher");
$stream->write("Don't know how to handle $selector\r\n");
}
$log->debug("Done");
};
$log->error("Error: $@") if $@;
alarm(0);
$stream->close_gracefully();
}
lib/App/Phoebe/Iapetus.pm view on Meta::CPAN
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();
}
}
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
push(@extensions, \&main);
sub main {
my $stream = shift;
my $url = shift;
my $port = App::Phoebe::port($stream);
if ($url =~ m!^gemini://(?:$host)(?::$port)?/play/ijirait\.tar\.gz$!) {
export_archive($stream);
}
elsif ($url =~ m!^gemini://(?:$host)(?::$port)?/play/ijirait(?:/([a-z]+))?(?:\?(.*))?!) {
my $command = ($1 || "look") . ($2 ? " " . decode_utf8 uri_unescape($2) : "");
$log->debug("Handling $url - $command");
# some commands require no client certificate (and no person argument!)
my $routine = $ijrait_commands_without_cert->{$command};
if ($routine) {
$log->debug("Running $command");
$routine->($stream);
return 1;
}
# regular commands
my $p = login($stream);
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
success($stream);
my $room = first { $_->{id} == $p->{location} } @{$data->{rooms}};
$stream->write(encode_utf8 "# " . $room->{name} . "\n");
$stream->write(encode_utf8 $room->{description} . "\n") if $room->{description};
my @things = grep { my $thing = $_;
not $thing->{hidden}
or $thing->{seen}
and any { $_ eq $thing->{seen} } @{$p->{seen}}} @{$room->{things}};
$stream->write("## Things\n") if @things > 0;
for my $thing (@things) {
my $name = uri_escape_utf8 $thing->{short};
$stream->write(encode_utf8 "=> /play/ijirait/examine?$name $thing->{name} ($thing->{short})\n");
}
my @exits = grep { my $exit = $_;
not $exit->{hidden}
or $exit->{seen}
and any { $_ eq $exit->{seen} } @{$p->{seen}} } @{$room->{exits}};
$stream->write("## Exits\n") if @exits > 0;
for my $exit (@exits) {
my $direction = uri_escape_utf8 $exit->{direction};
$stream->write(encode_utf8 "=> /play/ijirait/go?$direction $exit->{name} ($exit->{direction})\n");
}
$stream->write("## People\n"); # there is always at least the observer!
my $n = 0;
my $now = time;
for my $o (@{$data->{people}}) {
next unless $o->{location} == $p->{location};
next if $now - $o->{ts} > 600; # don't show people inactive for 10min or more
$n++;
my $name = uri_escape_utf8 $o->{name};
if ($o->{id} == $p->{id}) {
$stream->write(encode_utf8 "=> /play/ijirait/examine?$name $o->{name} (you)\n");
} else {
$stream->write(encode_utf8 "=> /play/ijirait/examine?$name $o->{name}\n");
}
}
my $title = 0;
for my $word (@{$room->{words}}) {
next if $now - $word->{ts} > 600; # don't show messages older than 10min
$stream->write("## Words\n") unless $title++;
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
my $tar = Archive::Tar->new;
my $bytes = "# Rooms\n";
$bytes .= encode_utf8 "=> rooms/$_->{id}.gmi $_->{name}\n" for @{$data->{rooms}};
$tar->add_data("ijirait/index.gmi", $bytes);
for my $room (@{$data->{rooms}}) {
$bytes = encode_utf8 "# " . $room->{name} . "\n";
$bytes .= encode_utf8 $room->{description} . "\n" if $room->{description};
my @things = @{$room->{things}};
$bytes .= "## Things\n" if @things > 0;
for my $thing (@things) {
my $name = uri_escape_utf8 $thing->{short};
$bytes .= encode_utf8 "=> ../things/$room->{id}/$name.gmi $thing->{name}\n";
my $bytes2 = encode_utf8 "# $thing->{name}\n";
$bytes2 .= encode_utf8 "$thing->{description}\n";
$bytes2 .= "=> ../../rooms/$room->{id}.gmi Back\n";
$tar->add_data("ijirait/things/$room->{id}/$name.gmi", $bytes2);
}
my @exits = @{$room->{exits}};
$bytes .= "## Exits\n" if @exits > 0;
for my $exit (@exits) {
my $direction = uri_escape_utf8 $exit->{direction};
my $destination = first { $_->{id} == $exit->{destination} } @{$data->{rooms}};
$bytes .= encode_utf8 "=> $destination->{id}.gmi $exit->{name}\n";
}
# We also print rooms without people! We also print inactive people.
my @people = grep { $_->{location} == $room->{id} } @{$data->{people}};
$bytes .= "## People\n" if @people > 0;
for my $o (@people) {
$bytes .= encode_utf8 "=> ../people/$o->{id}.gmi $o->{name}\n";
my $bytes2 = encode_utf8 "# $o->{name}\n";
$bytes2 .= encode_utf8 "$o->{description}\n";
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
}
sub describe {
my ($stream, $p, $text) = @_;
if ($text) {
my ($obj, $description) = split(/\s+/, $text, 2);
if ($obj eq "me") {
$log->debug("Describing $p->{name}");
notify($p, "$p->{name} changes appearance.");
$p->{description} = $description;
my $name = uri_escape_utf8 $p->{name};
result($stream, "30", "/play/ijirait/examine?$name");
return;
}
my $room = first { $_->{id} == $p->{location} } @{$data->{rooms}};
if ($obj eq "room") {
$log->debug("Describing $room->{name}");
notify($p, "$p->{name} changes the room’s description.");
$room->{description} = $description;
result($stream, "30", "/play/ijirait/look");
return;
}
my $thing = first { $_->{short} eq $obj } @{$room->{things}};
if ($thing) {
$log->debug("Describe $thing->{name}");
notify($p, "$p->{name} changes the description of $thing->{name}.");
$thing->{description} = $description;
my $name = uri_escape_utf8 $thing->{short};
result($stream, "30", "/play/ijirait/examine?$name");
return;
}
# No description of exits.
}
success($stream);
$log->debug("Describing unknown object");
$stream->write(encode_utf8 "# I don’t know what to describe\n");
$stream->write(encode_utf8 "The description needs to start with what to describe, e.g. “describe me A shape-shifter with red eyes.â€\n");
$stream->write(encode_utf8 "You can describe yourself (“meâ€), the room you are in (“roomâ€), or a thing (using its shortcut). You cannot describe exits.\n");
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
}
sub name {
my ($stream, $p, $text) = @_;
if ($text) {
my ($obj, $name) = split(/\s+/, $text, 2);
if ($obj eq "me" and $name !~ /\s/) {
$log->debug("Name $p->{name}");
notify($p, "$p->{name} changes their name to $name.");
$p->{name} = $name;
my $nm = uri_escape_utf8 $p->{name};
result($stream, "30", "/play/ijirait/examine?$nm");
return;
} elsif ($obj eq "room") {
my $room = first { $_->{id} == $p->{location} } @{$data->{rooms}};
$log->debug("Name $room->{name}");
notify($p, "$p->{name} changes the room’s name to $name.");
$room->{name} = $name;
result($stream, "30", "/play/ijirait/look");
return;
} else {
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
sub secrets {
my ($stream, $p, $phrase) = @_;
if ($phrase and $phrase eq "are something I do not care for!") {
$log->debug("Secrets");
my $room = first { $_->{id} == $p->{location} } @{$data->{rooms}};
my @things = grep { $_->{hidden} } @{$room->{things}};
my @exits = grep { $_->{hidden} } @{$room->{exits}};
if (@things > 0) {
$stream->write("## Hidden Things\n");
for my $thing (@things) {
my $name = uri_escape_utf8 $thing->{short};
$stream->write(encode_utf8 "=> /play/ijirait/examine?$name $thing->{name} ($thing->{short})\n");
}
}
if (@exits > 0) {
$stream->write("## Hidden Exits\n");
for my $exit (@exits) {
my $direction = uri_escape_utf8 $exit->{direction};
$stream->write(encode_utf8 "=> /play/ijirait/go?$direction $exit->{name} ($exit->{direction})\n");
}
}
if (@things + @exits == 0) {
$stream->write("## No secrets\n");
$stream->write("There are neither hidden things nor hidden exists, here\n");
}
$stream->write("=> /play/ijirait Back\n");
return;
}
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
$log->debug("Cannot find a route to '$name'");
$stream->write(encode_utf8 "# Cannot find a way\n");
$stream->write(encode_utf8 "There seems to be no way to get from here to $name.\n");
$stream->write(encode_utf8 "One of you must use the “connect†command to connect back to the rest of the game.\n");
$stream->write("=> /play/ijirait Back\n");
return;
}
success($stream);
$log->debug("Find '$name'");
$stream->write(encode_utf8 "# How to find $name\n");
my $room = uri_escape_utf8 $route->[0]->{direction};
$stream->write(encode_utf8 "=> /play/ijirait/$room $route->[0]->{name} ($route->[0]->{direction})\n");
for (1 .. $#$route) {
$stream->write(encode_utf8 "* $route->[$_]->{name} ($route->[$_]->{direction})\n");
}
$stream->write("=> /play/ijirait Back\n");
}
sub find_route {
my ($from, $to) = @_;
my %rooms = map { $_->{id} => $_ } @{$data->{rooms}};
lib/App/Phoebe/MokuPona.pm view on Meta::CPAN
push(@extensions, \&mokupona);
sub mokupona {
my $stream = shift;
my $url = shift;
my $port = port($stream);
if ($url =~ m!^gemini://$host(?::$port)?/do/moku-pona$!) {
result($stream, "31", "gemini://$host/do/moku-pona/updates.txt");
return 1;
} elsif ($url =~ m!^gemini://$host(?::$port)?/do/moku-pona/([^/]+)$!) {
my $file = decode_utf8(uri_unescape($1));
if (-f "$dir/$file") {
success($stream);
$stream->write(encode_utf8 read_text("$dir/$file"));
} else {
result($stream, "40", "Cannot read $dir/$file");
}
return 1;
}
return 0;
}
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
title => $id,
text => $data,
ns => $space,
answer => $token,
username => $name,
gemini => 1 });
$log->debug("Got " . $tx->result->code . " response");
if ($tx->result->code == 302) {
my $url = "gemini://$host:$port";
$url .= "/$space" if $space;
result($stream, "30", "$url/page/" . uri_escape_utf8($id) . "");
} else {
$stream->write("59 Got HTTP code " . $tx->result->code . " " . $tx->result->message
. " (" . $tx->req->url->to_abs . " " . $tx->req->params . ")\r\n");
}
$stream->close_gracefully();
}
*oddmuse_old_valid_token = \&App::Phoebe::valid_token;
*App::Phoebe::valid_token = \&oddmuse_new_valid_token;
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
my $reserved = reserved_regex();
my $port = port($stream);
my ($host, $space, $id, $query, $n, $style, $token);
if ($url =~ m!^gemini://$hosts(?::$port)?/robots\.txt$!) {
# must come before redirection to regular pages since it contains no slash
oddmuse_serve_robots($stream);
} elsif (($host, $n, $space) = $url =~ m!^gemini://$hosts(:$port)?(?:/($spaces))?/(?:$reserved)$!) {
result($stream, "31", "gemini://$host" . ($n ? ":$port" : "") . "/" . ($space ? $space : "") . ""); # this supports "up"
} elsif (($host, $space, $id, $n) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/page/([^/]+)(?:/(\d+))?$!
and $id ne $server->{wiki_main_page}) {
oddmuse_serve_page($stream, $host, decode_utf8(uri_unescape($space)), free_to_normal(decode_utf8(uri_unescape($id))), $n);
} elsif (($host, $space, $id) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/tag/([^/]+)$!) {
oddmuse_serve_tag($stream, $host, decode_utf8(uri_unescape($space)), free_to_normal(decode_utf8(uri_unescape($id))));
} elsif (($host, $space, $id) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/raw/([^/]+)$!
and $id ne $server->{wiki_main_page}) {
oddmuse_serve_raw($stream, $host, decode_utf8(uri_unescape($space)), free_to_normal(decode_utf8(uri_unescape($id))));
} elsif (($host, $space, $id) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/html/([^/]+)$!) {
oddmuse_serve_html($stream, $host, decode_utf8(uri_unescape($space)), free_to_normal(decode_utf8(uri_unescape($id))));
} elsif (($host, $space, $n) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/(?:blog|more)(?:/(\d+))?$!) {
oddmuse_serve_blog($stream, $host, decode_utf8(uri_unescape($space)), $n||10);
} elsif (($host, $space, $n) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/index$!) {
oddmuse_serve_index($stream, $host, decode_utf8(uri_unescape($space)));
} elsif (($host, $space, $n, $style) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/changes(?:/(\d+))?(?:/(colour|fancy))?$!) {
oddmuse_serve_changes($stream, $host, decode_utf8(uri_unescape($space)), $n||3, $style); # days!
} elsif (($host, $n, $style) = $url =~ m!^gemini://$hosts(?::$port)?/do/all/changes(?:/(\d+))?(?:/(colour|fancy))?$!) {
oddmuse_serve_changes($stream, $host, undef, $n||3, $style, 1); # days!
} elsif (($host, $space, $id, $style) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/history/([^/]*)(?:/(colour|fancy))?$!) {
oddmuse_serve_history($stream, $host, decode_utf8(uri_unescape($space)), free_to_normal(decode_utf8(uri_unescape($id))), $style);
} elsif (($host, $space, $id, $n, $style) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/diff/([^/]*)(?:/(\d+))?(?:/(colour))?$!) {
oddmuse_serve_diff($stream, $host, decode_utf8(uri_unescape($space)), free_to_normal(decode_utf8(uri_unescape($id))), $n, $style);
} elsif ($url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/match$!) {
result($stream, "10", "Find page by name (Perl regex)");
} elsif (($host, $space, $query) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/match\?([^#]+)!) {
oddmuse_serve_match($stream, $host, decode_utf8(uri_unescape($space)), decode_query($query));
} elsif ($url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/search$!) {
result($stream, "10", "Find page by content (Perl regex)");
} elsif (($host, $space, $query) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/search\?([^#]+)!) {
oddmuse_serve_search($stream, $host, decode_utf8(uri_unescape($space)), decode_query($query));
} elsif (($host, $space, $id, $query) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/comment/([^/#?]+)(?:\?([^#]+))?$!) {
oddmuse_comment($stream, $host, decode_utf8(uri_unescape($space)), free_to_normal(decode_utf8(uri_unescape($id))), decode_query($query));
} elsif (($host, $space) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/atom$!) {
oddmuse_serve_atom($stream, $host, decode_utf8(uri_unescape($space)), 'rc');
} elsif (($host, $space) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/rss$!) {
oddmuse_serve_rss($stream, $host, decode_utf8(uri_unescape($space)), 'rc');
} elsif (($host, $space) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/blog/atom$!) {
oddmuse_serve_atom($stream, $host, decode_utf8(uri_unescape($space)), 'journal');
} elsif (($host, $space) = $url =~ m!^gemini://$hosts(?::$port)?(?:/($spaces))?/do/blog/rss$!) {
oddmuse_serve_rss($stream, $host, decode_utf8(uri_unescape($space)), 'journal');
} elsif (($query) = $url =~ m!^GET (\S*) HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^$hosts(?::$port)(.*)$!) {
$log->info("Redirecting to https://$host$query");
$stream->write("HTTP/1.1 301 Back to port 443!\r\n");
$stream->write("Location: https://$host:443$query\r\n");
$stream->write("\r\n");
} else {
# We still rely on things like /do/spaces
# result($stream, "59", "I don't know how to handle this $url");
return 0;
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
}
sub oddmuse_get_page {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
my $url = "$oddmuse_wikis{$host}";
$url .= "/$space" if $space;
$url .= "/raw/" . uri_escape_utf8($id);
$url .= "?revision=$revision" if $revision;
return oddmuse_get_raw($stream, $url);
}
# It would be cool if this were streaming...
sub oddmuse_get_raw {
my $stream = shift;
my $url = shift;
$log->debug("Requesting $url");
my $ua = Mojo::UserAgent->new;
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
}
$stream->write(encode_utf8 oddmuse_footer($stream, $host, $space, $id));
}
sub oddmuse_gemini_text {
my $stream = shift;
my $host = shift;
my $space = shift;
my $text = shift;
my $id = shift;
# escape the preformatted blocks
my $ref = 0;
my @escaped;
my $link_regex = "([-,.()'%&!?;<> _1-9A-Za-z\x{0080}-\x{fffd}]|[-,.()'%&!?;<> _0-9A-Za-z\x{0080}-\x{fffd}][-,.()'%&!?;<> _0-9A-Za-z\x{0080}-\x{fffd}]+)";
my $wiki_word = '(\p{Uppercase}+\p{Lowercase}+\p{Uppercase}\p{Alphabetic}*)';
# newline magic: the escaped block does not include the newline; it is
# retained in $text so that the following rules still deal with newlines
# correctly; when we replace the escaped blocks back in, they'll be without
# the trailing newline and fit right in.
$text =~ s/^(```.*?\n```)\n/push(@escaped, $1); "\x03" . $ref++ . "\x04\n"/mesg;
$text =~ s/^<pre>\n?(.*?\n)<\/pre>\n?/push(@escaped, "```\n$1```\n"); "\x03" . $ref++ . "\x04\n"/mesg;
$text =~ s/^((\|.*\|\n)*\|.*\|)/push(@escaped, "```\n$1\n```"); "\x03" . $ref++ . "\x04\n"/meg;
my @blocks = split(/\n\n+|(?=\\\\\n)|\n(?=[*-]|=>)|\n\> *\n/, $text);
for my $block (@blocks) {
$block =~ s/^- /* /g; # fix list items
$block =~ s/\s+/ /g; # unwrap lines
$block =~ s/^\s+//; # trim
$block =~ s/\s+$//; # trim
my @links;
$block =~ s/^(=>.*)\n?/push(@links, $1); ""/gem;
$block =~ s/^$full_url_regex\n?/push(@links, "=> $1"); ""/ge;
$block =~ s/\[\[image(?:\/[^\/:]+)*:([^]|]+)\]\]\s*/push(@links, oddmuse_gemini_link($stream, $host, $space, "$1 (image)", $1)); ""/ge;
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
$block =~ s/#(\w+) */push(@links, oddmuse_gemini_link($stream, $host, $space, normal_to_free($1), "tag\/$1")); ""/ge; # hashtags at the end
$block .= "\n" if $block and @links; # no empty line if the block was all links
$block .= join("\n", uniq(@links));
}
$text = join("\n\n", @blocks); # add paragraph separation
$text =~ s/\n\\\\ //g; # remove paragraph separation for linebreaks
$text =~ s/^\* (.*)\n(=> \S+ \1)/$2/mg; # remove list items that are just links
$text =~ s/^(=?>.*\n)\n(?==>)/$1/mg; # remove empty lines between links or between links and quotes
$text =~ s/^(\* .*\n)\n(?=\* )/$1/mg; # remove empty lines between list items
$text =~ s/^Tags: .*/Tags:/m;
$text =~ s/\x03(\d+)\x04/$escaped[$1]/ge;
return $text . "\n";
}
sub oddmuse_gemini_link {
my $stream = shift;
my $host = shift;
my $space = shift;
my $title = shift;
my $id = shift;
$id = "page/" . free_to_normal($id) if $id and $id !~ /\//;
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
}
sub oddmuse_serve_raw {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
my $url = "$oddmuse_wikis{$host}";
$url .= "/$space" if $space;
$url .= "/raw/" . uri_escape_utf8($id);
$url .= "?revision=$revision" if $revision;
my $page = oddmuse_get_raw($stream, $url) // return;
if (my ($type, $data) = $page =~ /^#FILE (\S+) ?(?:\S+)?\n(.*)/s) {
oddmuse_serve_file_page($stream, $id, $type, $data);
return;
}
$log->info("Serving raw $id");
success($stream, 'text/plain; charset=UTF-8');
$stream->write(encode_utf8 $page);
}
sub oddmuse_serve_html {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
my $url = "$oddmuse_wikis{$host}";
$url .= "/$space" if $space;
$url .= "/" . uri_escape_utf8($id);
$url .= "?revision=$revision" if $revision;
my $page = oddmuse_get_raw($stream, $url) // return;
$log->info("Serving $id as HTML");
success($stream, 'text/html');
$stream->write(encode_utf8 $page);
}
sub free_to_normal {
my $title = shift;
$title =~ s/^ +//g;
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
}
sub oddmuse_serve_search {
my $stream = shift;
my $host = shift;
my $space = shift;
my $term = shift;
$log->info("Serving search for $term");
success($stream);
$stream->write(encode_utf8 "# Search ‘$term’\n");
my $url = "$oddmuse_wikis{$host}?raw=1&search=" . uri_escape_utf8($term);
my $page = oddmuse_get_raw($stream, $url) // return;
my @entries = split(/\n\n+/, $page);
shift @entries; # skip head
foreach my $entry (@entries) {
my $data = parse_data($entry);
my $id = $data->{title};
print_link($stream, $host, $space, normal_to_free($id), "page/$id");
}
}
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
*App::Phoebe::pages = \&oddmuse_pages_new;
sub oddmuse_pages_new {
my $stream = shift;
my $host = shift;
my $space = shift;
my $re = shift;
if (exists $oddmuse_wikis{$host}) {
my $url = "$oddmuse_wikis{$host}?raw=1;action=index";
$url .= ";ns=$space" if $space;
$url .= ";match=" . uri_escape_utf8($re) if $re;
return map { s/_/ /g; $_ } split(/\n/, oddmuse_get_raw($stream, $url));
}
return oddmuse_pages_old($stream, $host, $space, $re);
}
# this is required when combining gopher with oddmuse!
*oddmuse_search_old = \&App::Phoebe::search;
*App::Phoebe::search = \&oddmuse_search_new;
sub oddmuse_search_new {
my $stream = shift;
my $host = shift;
my $space = shift;
my $re = shift;
if (exists $oddmuse_wikis{$host}) {
my $url = "$oddmuse_wikis{$host}?raw=1";
$url .= ";ns=$space" if $space;
$url .= ";context=0;search=" . uri_escape($re) if $re;
return map { s/_/ /g; $_ } split(/\n/, oddmuse_get_raw($stream, $url));
}
return oddmuse_search_old($stream, $host, $space, $re, @_);
}
sub oddmuse_serve_changes {
my $stream = shift;
my $host = shift;
my $space = shift;
my $n = shift;
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
my $host = shift;
my $space = shift;
my $id = shift;
my $style = shift;
success($stream);
$log->info("Serve history for $id");
$stream->write("# Page history for " . normal_to_free($id) . "\n");
if (not $style) { print_link($stream, $host, $space, "Colour history", "history/$id/colour") }
elsif ($style eq "colour") { print_link($stream, $host, $space, "Fancy history", "history/$id/fancy") }
elsif ($style eq "fancy") { print_link($stream, $host, $space, "Normal history", "history/$id") }
my $url = "$oddmuse_wikis{$host}?raw=1;action=history;id=" . uri_escape_utf8($id);
$url .= ";ns=$space" if $space;
my $page = oddmuse_get_raw($stream, $url) // return;
my @entries = split(/\n\n+/, $page);
shift @entries; # skip head
my $log;
foreach my $entry (@entries) {
my $data = parse_data($entry);
# timestamp from 2020-07-22T20:59Z back to a number
my $ts = $data->{"last-modified"};
$ts =~ s/Z/:00Z/; # apparently seconds are mandatory?
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
my $space = shift;
my $id = shift;
my $revision = shift;
my $style = shift;
$log->info("Serving the diff of $id");
success($stream);
$stream->write("# Differences for " . normal_to_free($id) . "\n");
if (not $style) { print_link($stream, $host, $space, "Colour diff", "diff/$id/$revision/colour") }
else { print_link($stream, $host, $space, "Normal diff", "diff/$id/$revision") }
$stream->write("Showing the differences between revision $revision and the current revision.\n");
my $url = $oddmuse_wikis{$host} . ($space ? "/$space" : "") . "/raw/" . uri_escape_utf8($id);
my $new = oddmuse_get_raw($stream, $url);
$url .= "?revision=$revision" if $revision;
my $old = oddmuse_get_raw($stream, $url);
if (not $style) {
diff($old, $new,
sub { $stream->write(encode_utf8 "$_\n") for @_ },
sub { $stream->write(encode_utf8 "> $_\n") for map { $_||"âŽ" } @_ },
sub { $stream->write(encode_utf8 "> $_\n") for map { $_||"âŽ" } @_ },
sub { "ï½¢$_[0]ï½£" });
} else {
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
$data = parse_data(shift(@entries));
$stream->write("<item>\n");
# namespaces
my $ns;
my $title = $data->{title};
if ($title =~ /:/) {
($ns, $title) = split(/:/, $title);
}
my $id = free_to_normal($title);
$stream->write(encode_utf8 "<title>" . quote_html($data->{title}) . "</title>\n");
my $link = "gemini://$host:$port/" . ($ns ? "$ns/" : "") . "page/" . uri_escape_utf8($id);
$stream->write("<link>$link</link>\n");
$stream->write("<guid>$link</guid>\n");
$link = "gemini://$host:$port/" . ($ns ? "$ns/" : "") . "page/Comments_on_" . uri_escape_utf8($id);
$stream->write("<comments>$link</comments>\n");
my $summary = quote_html(oddmuse_gemini_text($stream, $host, $space, $data->{description}, $id));
$stream->write(encode_utf8 "<description>$summary</description>\n") if $summary;
# timestamp from 2020-07-22T20:59Z back to a number
my $ts = $data->{"last-modified"};
$ts =~ s/Z/:00Z/; # apparently seconds are mandatory?
$ts = DateTime::Format::ISO8601->parse_datetime($ts)->epoch();
my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($ts); # Sat, 07 Sep 2002 00:00:01 GMT
$stream->write("<pubDate>"
. sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", qw(Sun Mon Tue Wed Thu Fri Sat)[$wday], $mday,
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
my $page = oddmuse_get_raw($stream, $url) // return;
my @entries = split(/\n\n+/, $page);
my $data = parse_data(shift @entries);
$stream->write(encode_utf8 "<title>" . quote_html($data->{title}) . "</title>\n");
while (@entries) {
$data = parse_data(shift @entries);
$stream->write("<entry>\n");
my $name = $data->{title};
my $id = free_to_normal($name);
$stream->write(encode_utf8 "<title>$name</title>\n");
my $link = "gemini://$host:$port/page/" . uri_escape_utf8($id);
$stream->write("<link href=\"$link\"/>\n");
$stream->write("<id>$link</id>\n");
my $summary = quote_html(oddmuse_gemini_text($stream, $host, $space, $data->{description}, $id));
$stream->write(encode_utf8 "<content type=\"text\">$summary</content>\n") if $summary;
$stream->write("<updated>$data->{'last-modified'}</updated>\n");
$stream->write("</entry>\n");
};
$stream->write("</feed>\n");
}
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
title => $id,
ns => $space,
aftertext => $query,
username => $name,
answer => $token,
gemini => 1 });
$log->debug("Got " . $tx->result->code . " response");
if ($tx->result->code == 302) {
my $url = "gemini://$host:$port";
$url .= "/$space" if $space;
result($stream, "30", "$url/page/" . uri_escape_utf8($id) . "");
return;
}
$stream->write("59 Got HTTP code " . $tx->result->code . " " . $tx->result->message
. " (" . $tx->req->url->to_abs . " " . $tx->req->params . ")\r\n");
}
# If the fingerprint exists in our file, no need to ask for the $token; it
# expires after a day (24 * 60 * 60 seconds). If no fingerprint is found, ask
# for a cert.
sub oddmuse_fingerprint_name {
lib/App/Phoebe/Oracle.pm view on Meta::CPAN
while (1) {
my $n = int(rand(10000));
return $n unless any { $n eq $_->{number} } @$data;
}
}
sub decode_query {
my $text = shift;
return '' unless $text;
$text =~ s/\+/ /g;
return decode_utf8(uri_unescape($text));
}
sub serve_main_menu {
my ($stream, $host) = @_;
my $data = load_data($host);
my $fingerprint = $stream->handle->get_fingerprint();
success($stream);
$log->info("Serving oracles");
$stream->write("# Oracle\n");
if ($fingerprint) {
lib/App/Phoebe/Spartan.pm view on Meta::CPAN
# config file goes first (note that $path and $length come at the end)
} elsif (($space) = $path =~ m!^(?:/($spaces))?(?:/page)?/?$!) {
# "up" from page/Alex gives us page or page/ → show main menu
spartan_main_menu($stream, $host, space($stream, $host, $space));
} elsif ($path eq "/do/source") {
seek DATA, 0, 0;
local $/ = undef; # slurp
$stream->write(encode_utf8 <DATA>);
} elsif ($length == 0 and ($space, $id, $n) = $path =~ m!^(?:/($spaces))?/page/([^/]+)(?:/(\d+))?$!) {
$log->debug("Serving $id bytes via Spartan");
serve_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif ($length > 0 and ($space, $id, $n) = $path =~ m!^(?:/($spaces))?/page/([^/]+)$!) {
$log->debug("Saving $length bytes via Spartan");
save_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)),
"text/plain", $buffer, $length);
} elsif (($space, $id) = $path =~ m!^(?:/($spaces))?/raw/([^/]+)$!) {
serve_raw($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
} elsif (($space, $id) = $path =~ m!^(?:/($spaces))?/html/([^/]+)$!) {
serve_html($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
} elsif (($space, $id) = $path =~ m!^(?:/($spaces))?/history/([^/]+)$!) {
serve_history($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), 10);
} elsif (($space, $id, $n) = $path =~ m!^(?:/($spaces))?/diff/([^/]+)(?:/(\d+))?$!) {
serve_diff($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif (($space) = $path =~ m!^(?:/($spaces))?/do/index$!) {
serve_index($stream, $host, space($stream, $host, $space));
} else {
$log->info("No handler for $host $path $length via spartan");
result($stream, "5", "I do not know what to do with $host $path $length");
}
$log->debug("Done");
};
$log->error("Error: $@") if $@;
alarm(0);
lib/App/Phoebe/StaticFiles.pm view on Meta::CPAN
our %routes;
sub static_routes {
my ($stream, $url) = @_;
my $host = host_regex();
my $port = port($stream);
if ($url =~ m!^gemini://($host)(?::$port)?/do/static/?$!) {
$log->debug("Serving the list of static routes");
success($stream);
for my $route (sort keys %routes) {
$stream->write("=> /do/static/" . uri_escape_utf8($route) . " " . encode_utf8($route) . "\n");
}
return 1;
} elsif ($url =~ m!^gemini://($host)(?::$port)?/do/static/([^/]+)/?$!) {
my $route = decode_utf8(uri_unescape($2));
my $dir = $routes{$route};
$log->debug("Serving list of files at $route, reading $dir");
if ($dir) {
success($stream);
my @files = map { $_->basename } Mojo::File->new($dir)->list->each;
for my $file (sort map { decode_utf8($_) } @files) {
$stream->write("=> /do/static/" . uri_escape_utf8($route) . "/" . uri_escape_utf8($file)
. " " . encode_utf8($file) . "\n");
}
} else {
result($stream, "40", "Unknown route: " . encode_utf8($route));
}
return 1;
} elsif ($url =~ m!^gemini://($host)(?::$port)?/do/static/([^/]+)/([^.].*)$!i) {
my $route = decode_utf8(uri_unescape($2));
my $file = decode_utf8(uri_unescape($3));
$log->debug("Serving $route/$file");
my $dir = $routes{$route};
return result($stream, "40", "Unknown route: " . encode_utf8($route))
unless $dir;
my $path = Mojo::File->new($dir, $file);
return result($stream, "40", "Unknown file: " . encode_utf8($file))
unless -f $path and is_in(Mojo::File->new($dir), $path);
success($stream, mime_type($$path));
$stream->write($path->slurp);
return 1;
lib/App/Phoebe/Web.pm view on Meta::CPAN
if (run_extensions($stream, $request, $headers, $buffer)) {
# config file goes first
} elsif ($request =~ m!^GET /default.css HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_css_via_http($stream, $host);
} elsif (($space) = $request =~ m!^GET (?:(?:/($spaces)/?)?|/) HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_main_menu_via_http($stream, $host, space($stream, $host, $space));
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/page/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_page_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/file/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_file_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/history/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_history_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/diff/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_diff_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/raw/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_raw_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif ($request =~ m!^GET /robots.txt(?:[#?].*)? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_raw_via_http($stream, $host, undef, 'robots');
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/changes(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_changes_via_http($stream, $host, space($stream, $host, $space), $n||100);
} elsif (($filter, $n) = $request =~ m!^GET /do/all(?:/(latest))?/changes(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_all_changes_via_http($stream, $host, $n||100, $filter||"");
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/index HTTP/1\.[01]$!
lib/App/Phoebe/Web.pm view on Meta::CPAN
my $host = shift;
my $space = shift;
my $title = shift;
my $id = shift;
if (not $id) {
$id = "page/$title";
}
my $port = port($stream);
# don't encode the slash
return "<a href=\"https://$host:$port/"
. ($space && $space ne $host ? uri_escape_utf8($space) . "/" : "")
. join("/", map { uri_escape_utf8($_) } split (/\//, $id))
. "\">"
. quote_html($title)
. "</a>";
}
sub blog_html {
my $stream = shift;
my $host = shift;
my $space = shift;
my $n = shift || 10;
lib/App/Phoebe/Web.pm view on Meta::CPAN
sub { $stream->write("<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
sub { $stream->write(encode_utf8 "<br> → " . link_html($stream, @_) . "\n") },
sub { $stream->write(encode_utf8 "<br> → $_[0]\n") },
sub { @{shift(@$log) }, 1 if @$log },
undef,
$filter);
return unless $more;
$stream->write("<p>" . link_html($stream, $host, undef, "More...", "do/all/changes/" . 10 * $n) . "\n");
}
# https://en.wikipedia.org/wiki/ANSI_escape_code#3/4_bit
sub colourize_html {
my $stream = shift;
my $code = shift;
my %rgb = (
0 => "0,0,0",
1 => "222,56,43",
2 => "57,181,74",
3 => "255,199,6",
4 => "0,111,184",
5 => "118,38,113",
lib/App/Phoebe/Web.pm view on Meta::CPAN
},
sub { "<br> → $_[0]" },
sub {
READ:
return unless $_ = decode_utf8($fh->readline);
chomp;
my ($ts, $id_log, $revision, $code) = split(/\x1f/);
goto READ if $id_log ne $id;
$ts, $id_log, $revision, $code, $host, $space, 0 });
return unless $more;
$stream->write("<p>" . link_html($stream, $host, $space, "More...", "history/" . uri_escape_utf8($id) . "/" . 10 * $n) . "\n");
}
sub serve_file_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
$log->info("Serve file $id");
my $dir = wiki_dir($host, $space);
lib/App/Phoebe/WebComments.pm view on Meta::CPAN
use Encode qw(decode_utf8 encode_utf8);
use File::Slurper qw(read_text);
use utf8;
push(@footer, \&add_comment_web_link_to_footer);
sub add_comment_web_link_to_footer {
my ($self, $host, $space, $id, $revision, $scheme) = @_;
# only leave comments on current comment pages
return "" if $revision;
$space = "/" . uri_escape_utf8($space) if $space;
$space //= "";
return "=> $space/page/" . uri_escape_utf8("Comments on $id") . " Comments"
if $id !~ /^Comments on / and not grep { $_ eq \&add_comment_link_to_footer } @footer;
return "=> $space/do/comment/" . uri_escape_utf8($id) . " Leave a short comment" if $scheme eq "html";
}
unshift(@request_handlers, '^POST .* HTTP/1\.[01]$' => \&handle_http_header);
push(@extensions, \&process_comment_requests_via_http);
sub process_comment_requests_via_http {
my ($stream, $url, $headers, $buffer) = @_;
my $hosts = host_regex();
my $spaces = space_regex();
my $port = port($stream);
my ($host, $space, $id, $token, $query);
if (($space, $id) = $url =~ m!^GET (?:/($spaces))?/do/comment/([^/#?]+) HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_comment_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
return 1;
} elsif (($space, $id) = $url =~ m!^POST (?:/($spaces))?/do/comment/([^/#?]+) HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
append_comment_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $buffer);
return 1;
}
return 0;
}
sub serve_comment_via_http {
my ($stream, $host, $space, $id) = @_;
$log->info("Serve comments for $id via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: text/html\r\n");
lib/App/Phoebe/WebComments.pm view on Meta::CPAN
$stream->write("</form>\r\n");
$stream->write("</body>\r\n");
$stream->write("</html>\r\n");
}
sub append_comment_via_http {
my ($stream, $host, $space, $id, $buffer) = @_;
$log->info("Save comments for $id via HTTP");
my %params;
for (split(/&/, $buffer)) {
my ($key, $value) = map { s/\+/ /g; decode_utf8(uri_unescape($_)) } split(/=/, $_, 2);
$params{$key} = $value;
}
$log->debug("Parameters: " . join(", ", map { "$_ => '$params{$_}'" } keys %params));
my $token = quotemeta($params{token}||"");
my @tokens = @{$server->{wiki_token}};
push(@tokens, @{$server->{wiki_space_token}->{$space}})
if $space and $server->{wiki_space_token}->{$space};
return http_error($stream, "Token required") if not $token and @tokens;
return http_error($stream, "Wrong token") if not grep(/^$token$/, @tokens);
my $comment = $params{comment};
lib/App/Phoebe/WebDAV.pm view on Meta::CPAN
sub process_webdav {
my ($stream, $request, $headers, $buffer) = @_;
my $hosts = host_regex();
my $port = port($stream);
my $spaces = space_regex();
my ($method, $host, $space, $path, $id);
if (($space, $path, $id)
= $request =~ m!^OPTIONS (?:/($spaces))?(/(?:login|(?:file|page|raw)(?:/([^/]*))?)?)? HTTP/1\.1$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
return if $path eq "/login" and not authorize($stream, $host, space($stream, $host, $space), $headers);
options($stream, map { decode_utf8(uri_unescape($_)) } $path, $id);
} elsif (($space, $path, $id)
= $request =~ m!^PROPFIND (?:/($spaces))?(/(?:login/?|(?:file|page|raw)(?:/([^/]*))?)?)? HTTP/1\.1$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
propfind($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers, $buffer);
} elsif (($space, $path, $id)
= $request =~ m!^PUT (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
put($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers, $buffer);
} elsif (($space, $path, $id)
= $request =~ m!^DELETE (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
remove($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers);
} elsif (($space, $path, $id)
= $request =~ m!^COPY (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
copy($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers);
} elsif (($space, $path, $id)
= $request =~ m!^MOVE (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
move($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers);
} else {
return 0;
}
return 1;
}
my %implemented = (
options => '*',
propfind => '*',
get => 'r', # handled by App::Phoebe::Web
lib/App/Phoebe/WebDAV.pm view on Meta::CPAN
$stream->write("Content-Location: $path/\r\n");
}
$stream->write("\r\n");
$stream->write($str);
}
sub to_url {
my $space = shift;
my $resource = shift;
my $href;
$href .= "/" . uri_escape_utf8($space) if $space;
# split doesn't produce empty fields at the end
my $d = substr($resource, -1) eq "/";
$href .= join("/", map { uri_escape_utf8($_) } split (/\//, $resource));
$href .= "/" if $d;
return $href;
}
sub put {
my ($stream, $host, $space, $path, $id, $headers, $buffer) = @_;
return unless authorize($stream, $host, $space, $headers);
return remove($stream, $host, $space, $path, $id, $headers) if length($buffer) == 0;
my $mime = $headers->{"content-type"} // guess_mime_type(\$buffer);
return webdav_error($stream, "Content type not known") unless $mime;
lib/App/Phoebe/WebDAV.pm view on Meta::CPAN
$log->debug("Copying $source");
return webdav_error($stream, "Resource is missing") unless -e $source;
my $data = read_binary($source);
# figure out the destination
my $hosts = host_regex();
my $port = port($stream);
my $spaces = space_regex();
my ($dest_host, $dest_space, $dest_path, $dest_id) =
$destination =~ m!^https://($hosts)(?::$port)(?:/($spaces))?(/(?:file|raw)/([^/]*))!;
if ($dest_id) {
put($stream, $host, space($stream, $host, $dest_space), $dest_path, decode_utf8(uri_unescape($dest_id)), $headers, $data);
} else {
return webdav_error($stream, "Copying to remote servers not supported");
}
}
sub move {
remove(@_) if copy(@_);
}
sub webdav_error {
lib/App/Phoebe/WebEdit.pm view on Meta::CPAN
my ($space) = @_;
my $editable = { return test => 1, gemini => 1 };
return $editable->{$space};
}
sub add_edit_link_to_footer {
my ($stream, $host, $space, $id, $revision, $format) = @_;
# only add the edit links to the web UI of the test space
# return if not $space or not is_editable($space);
return "" if $revision or not $id or $format ne "html";
$id = uri_escape_utf8($id);
if ($space) {
$space = uri_escape_utf8($space);
return "=> /$space/do/edit/$id Edit";
} else {
return "=> /do/edit/$id Edit";
}
}
# note that the requests handled here must be protected in
# App::Phoebe::RegisteredEditorsOnly!
push(@extensions, \&process_edit_requests);
sub process_edit_requests {
my ($stream, $request, $headers, $buffer) = @_;
my $host_regex = host_regex();
my $spaces = space_regex();
my $port = port($stream);
my ($host, $space, $id, $token, $query);
if (($space, $id) = $request =~ m!^GET (?:/($spaces))?/do/edit/([^/#?]+) HTTP/1\.[01]$!
and is_editable($space)
and ($host) = $headers->{host} =~ m!^($host_regex)(?::$port)$!) {
serve_edit_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
} elsif (($space, $id) = $request =~ m!^POST (?:/($spaces))?/do/edit/([^/#?]+) HTTP/1\.[01]$!
and is_editable($space)
and ($host) = $headers->{host} =~ m!^($host_regex)(?::$port)$!) {
save_edit_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $headers, $buffer);
} else {
return 0;
}
return 1;
}
sub serve_edit_via_http {
my ($stream, $host, $space, $id) = @_;
$log->info("Serve edit page for $id via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
lib/App/Phoebe/WebEdit.pm view on Meta::CPAN
sub save_edit_via_http {
my ($stream, $host, $space, $id, $headers, $buffer) = @_;
$log->info("Save edit for $id via HTTP");
return http_error($stream, "Page name is missing") unless $id;
return http_error($stream, "Page names must not control characters") if $id =~ /[[:cntrl:]]/;
return http_error($stream, "Content type not known")
if not $headers->{"content-type"} or $headers->{"content-type"} ne "application/x-www-form-urlencoded";
my %params;
for (split(/&/, $buffer)) {
my ($key, $value) = map { s/\+/ /g; decode_utf8(uri_unescape($_)) } split(/=/, $_, 2);
$params{$key} = $value;
}
$log->debug("Parameters: " . join(", ", map { "$_ => '$params{$_}'" } keys %params));
my $token = quotemeta($params{token}||"");
my @tokens = @{$server->{wiki_token}};
push(@tokens, @{$server->{wiki_space_token}->{$space}})
if $space and $server->{wiki_space_token}->{$space};
if (@tokens) {
if (not $token) {
$log->info("Token required (one of @tokens)");
lib/App/Phoebe/WebStaticFiles.pm view on Meta::CPAN
$stream->write("<head>\n");
$stream->write("<meta charset=\"utf-8\">\n");
$stream->write("<title>All Directories</title>\n");
$stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
$stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
$stream->write("</head>\n");
$stream->write("<body>\n");
$stream->write("<h1>All Directories</h1>\n");
$stream->write("<ul>\n");
for my $route (sort keys %routes) {
$stream->write("<li><a href=\"/do/static/" . uri_escape_utf8($route) . "\">"
. encode_utf8($route) . "</a>\n");
}
$stream->write("</ul>\n");
$stream->write("</body>\n");
$stream->write("</html>\n");
return 1;
} elsif (($route) = $request =~ m!^GET /do/static/([^/]+)/? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
my $route = decode_utf8(uri_unescape($route));
my $dir = $routes{$route};
if (not $dir) {
http_error($stream, "Unknown route: " . encode_utf8($route));
return 1;
}
$log->debug("Serving list of files at $route via the web, reading $dir");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: text/html\r\n");
$stream->write("\r\n");
$stream->write("<!DOCTYPE html>\n");
lib/App/Phoebe/WebStaticFiles.pm view on Meta::CPAN
$stream->write("<head>\n");
$stream->write("<meta charset=\"utf-8\">\n");
$stream->write("<title>Files</title>\n");
$stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
$stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
$stream->write("</head>\n");
$stream->write("<body>\n");
$stream->write("<h1>Files</h1>\n");
$stream->write("<ul>\n");
for my $file (sort map { decode_utf8($_) } grep !/^\./, read_dir($dir)) {
$stream->write(encode_utf8 "<li><a href=\"/do/static/" . uri_escape_utf8($route) . "/"
. uri_escape_utf8($file) . "\">"
. encode_utf8($file) . "</a>\n");
}
$stream->write("</ul>\n");
$stream->write("</body>\n");
$stream->write("</html>\n");
return 1;
} elsif (($route, $file) = $request =~ m!^GET /do/static/([^/]+)/([^.].*) HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
my $route = decode_utf8(uri_unescape($route));
my $file = decode_utf8(uri_unescape($file));
$log->debug("Serving $route/$file via the web");
my $dir = $routes{$route};
# no slashes in the file name!
if ($file =~ /\// or not $dir or not -f "$dir/$file") {
http_error($stream, "Unknown file: " . encode_utf8($file));
return 1;
}
my $mime = mime_type($file);
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: $mime\r\n");
lib/App/Phoebe/Wikipedia.pm view on Meta::CPAN
push(@extensions, \&wikipedia);
my $link_regex = "([-,.()'%&!?;<> _1-9A-Za-z\x{0080}-\x{fffd}]|[-,.()'%&!?;<> _0-9A-Za-z\x{0080}-\x{fffd}][-,.()'#%&!?;<> _0-9A-Za-z\x{0080}-\x{fffd}]+)"; # disallow "0" and must match HTML and plain text (ie. > and >)
sub wikipedia {
my $stream = shift;
my $url = shift;
my $headers = shift;
my $port = App::Phoebe::port($stream);
if ($url =~ m!^gemini://$host(?::$port)?/search/([a-z]+)/([^?;]+)!) {
wikipedia_serve_search($stream, $1, decode_utf8(uri_unescape($2)));
} elsif ($url =~ m!^gemini://$host(?::$port)?/text/([a-z]+)/([^?;]+)!) {
wikipedia_serve_text($stream, $1, decode_utf8(uri_unescape($2)));
} elsif ($url =~ m!^gemini://$host(?::$port)?/full/([a-z]+)/([^?;]+)!) {
wikipedia_serve_full($stream, $1, decode_utf8(uri_unescape($2)));
} elsif ($url =~ m!^gemini://$host(?::$port)?/raw/([a-z]+)/([^?;]+)!) {
wikipedia_serve_raw($stream, $1, decode_utf8(uri_unescape($2)));
} elsif ($url =~ m!^gemini://$host(?::$port)?/?$!) {
$log->info("Asking for a language");
result($stream, "10", "Search in which language? (ar, cn, en, fr, ru, es, etc.)");
} elsif ($url =~ m!^gemini://$host(?::$port)?/?\?([a-z]+)$!) {
$log->info("Redirecting to ask for a term");
my $lang = $1;
result($stream, "30", "gemini://$host:$port/$lang");
} elsif ($url =~ m!^gemini://$host(?::$port)?/([a-z]+)$!) {
$log->info("Asking for a term");
my $lang = $1;
lib/App/Phoebe/Wikipedia.pm view on Meta::CPAN
my $articles = $mw->list({
action => 'query',
list => 'prefixsearch',
pssearch => $term, });
if (not $articles) {
result($stream, "43", "Wikipedia says $mw->{error}->{code}: $mw->{error}->{details}");
$stream->close_gracefully();
return;
}
result($stream, "20", "text/gemini;lang=$lang");
$stream->write("# Searching for " . encode_utf8(uri_unescape($term)) . "\n");
foreach (@$articles) {
wikipedia_print_link($stream, $lang, $_->{title}, 'text', $_->{title});
}
$stream->write("\n\n");
$stream->write("=> https://$lang.wikipedia.org/wiki/" . uri_escape_utf8($term) . " Source\n");
}
sub wikipedia_serve_raw {
my $stream = shift;
my $lang = shift;
my $term = shift;
$log->info("Wikipedia getting $lang/$term");
my $mw = MediaWiki::API->new();
$mw->{config}->{api_url} = "https://$lang.wikipedia.org/w/api.php";
my $result = $mw->api({
lib/App/Phoebe/Wikipedia.pm view on Meta::CPAN
result($stream, "20", "text/plain");
$stream->write(encode_utf8 $result->{parse}->{wikitext});
}
sub wikipedia_print_link {
my $stream = shift;
my $lang = shift;
my $term = shift;
my $type = shift||"text";
my $title = shift||$term;
$stream->write("=> /$type/$lang/" . uri_escape_utf8($term) . " " . encode_utf8($title) . "\n");
}
sub wikipedia_serve_text {
my $stream = shift;
my $lang = shift;
my $term = shift;
$log->info("Wikipedia getting $lang/$term");
my $mw = MediaWiki::API->new();
$mw->{config}->{api_url} = "https://$lang.wikipedia.org/w/api.php";
my $result = $mw->api({
lib/App/Phoebe/Wikipedia.pm view on Meta::CPAN
prop => 'wikitext',
formatversion => '2',
page => $term, });
result($stream, "20", "text/gemini;lang=$lang");
my $title = $result->{parse}->{title};
my $text = wikipedia_extract($stream, $lang, $result->{parse}->{wikitext});
$stream->write(encode_utf8 "# $title\n");
$stream->write(encode_utf8 "$text\n\n");
wikipedia_print_link($stream, $lang, $term, 'full', "Full text");
wikipedia_print_link($stream, $lang, $term, 'raw', "Raw text");
$stream->write("=> https://$lang.wikipedia.org/wiki/" . uri_escape_utf8($term) . " Source\n");
}
sub wikipedia_extract {
my $stream = shift;
my $lang = shift;
my $text = shift;
my @sections = split(/\n+==.*==\n+/, $text);
return wikipedia_text($stream, $lang, $sections[0]);
}
sub wikipedia_text {
my $stream = shift; # only used to pass to gemini_link for the port
my $lang = shift;
my $text = shift;
# escape some stuff
my $ref = 0;
my @escaped;
# main articles and other templates
$text =~ s/^\{\{\s*main\s*\|(.+?)\}\}/push(@escaped, gemini_link($stream, "vault.transjovian.org", undef, "Main article: $1", "text\/$lang\/$1")); "\x03" . $ref++ . "\x04\n"/simeg;
# e.g. gemini://vault.transjovian.org/text/en/Zuihitsu
$text =~ s/\{\{\s*nihongo\s*\|(.+?)\|(.+?)\}\}/$1 ($2)/sig;
# strip citations
$text =~ s/\{\{\s*cite\s+[^{}]+\}\}//sig;
# handle quotes (now without the citations)
$text =~ s/\{\{\s*quote\s*\|(?:text=)?(.+?)\}\}/ï½¢$1ï½£/sig;
# strip all other templates
do {} while $text =~ s/\{\{[^{}]+\}\}//g;
# strip remaining empty brackets
$text =~ s/\(\s*\)//g;
# handle tables
# $text =~ s/^(\{\|.+?\|\})\n?/push(@escaped, wikipedia_table($1)); "\x03" . $ref++ . "\x04"/mesg;
my @blocks = split(/\n\n+|\n(?=[*#=])|<br\s+\/>/, $text);
for my $block (@blocks) {
$block =~ s/\s+/ /g; # unwrap lines
$block =~ s/^\s+//; # trim
$block =~ s/\s+$//; # trim
$block = wikipedia_format($block);
}
$text = join("\n\n", @blocks);
# replace the preformatted blocks
$text =~ s/\x03(\d+)\x04/$escaped[$1]/g;
return $text;
}
sub wikipedia_table {
my $text = shift;
my $caption = "";
my $data;
my @row;
$log->debug("Parsing table");
for (split(/\n/, $text)) {
lib/App/Phoebe/Wikipedia.pm view on Meta::CPAN
action => 'parse',
prop => 'wikitext',
formatversion => '2',
page => $term, });
result($stream, "20", "text/gemini;lang=$lang");
my $title = $result->{parse}->{title};
my $text = wikipedia_text($stream, $lang, $result->{parse}->{wikitext});
$stream->write(encode_utf8 "# $title\n");
$stream->write(encode_utf8 "$text\n\n");
wikipedia_print_link($stream, $lang, $term, 'text', "Short text");
$stream->write("=> https://$lang.wikipedia.org/wiki/" . uri_escape_utf8($term) . " Source\n");
}
1;
script/gemini view on Meta::CPAN
die "âš You must provide an URI\n" unless $uri;
my $iri = IRI->new(value => encode_utf8 $uri);
die "âš The URI '$uri' must use the gemini scheme\n" unless $iri->scheme and $iri->scheme eq 'gemini';
die "âš The URI '$uri' must have an authority\n" unless $iri->authority;
my $host = domain_to_ascii(decode_utf8 $iri->host);
my $port = $iri->port || 1965;
my $unsafe = "^A-Za-z0-9\-\._~%"; # the default + already encoded
my $path = uri_escape_utf8($iri->path, $unsafe . "/"); # path separator are safe
my $query = uri_escape_utf8($iri->query, $unsafe . "&;="); # parameter separators are safe
my $fragment = uri_escape_utf8($iri->fragment); # use the default
$uri = $iri->scheme . '://' . $host . ':' . $port;
$uri .= $path if $path;
$uri .= '?' . $query if $query;
$uri .= '#' . $fragment if $fragment;
warn "Contacting $host:$port" if $verbose;
# create client
Mojo::IOLoop->client({
script/gemini-chat view on Meta::CPAN
my $iri = IRI->new(value => encode_utf8 $uri);
die "âš The URI '$uri' must use the gemini scheme\n" unless $iri->scheme and $iri->scheme eq 'gemini';
die "âš The URI '$uri' must have an authority\n" unless $iri->authority;
warn "âš Ignoring path '" . $iri->path . "'\n" if $iri->path;
warn "âš Ignoring fragment '" . $iri->fragment . "'\n" if $iri->fragment;
my $host = domain_to_ascii(decode_utf8 $iri->host);
my $port = $iri->port || 1965;
my $unsafe = "^A-Za-z0-9\-\._~"; # the default
my $path = uri_escape_utf8($iri->path, $unsafe . "/"); # path separator are safe
$uri = $iri->scheme . '://' . $host . ':' . $port;
$uri .= $path if $path;
# start read loop for saying stuff
my $term = Term::ReadLine->new($uri);
my $prompt = "> ";
my $OUT = $term->OUT || \*STDOUT;
while (defined ($_ = $term->readline($prompt))) {
exit if $_ eq "quit";
# create client
my $text = uri_escape_utf8($_);
Mojo::IOLoop->client({
address => $host,
port => $port,
tls => 1,
tls_cert => $cert,
tls_key => $key,
tls_options => { SSL_verify_mode => 0x00 }} => sub {
my ($loop, $err, $stream) = @_;
die $err if $err;
$stream->on(read => sub {
script/ijirait view on Meta::CPAN
C<cpanm> to install them.
=over
=item L<Modern::Perl> from C<libmodern-perl-perl>
=item L<Mojo::IOLoop> from C<libmojolicious-perl>
=item L<Term::ReadLine::Gnu> from C<libterm-readline-gnu-perl>
=item L<URI::Escape> from C<liburi-escape-xs-perl>
=item L<Encode::Locale> from C<libencode-locale-perl>
=item L<Text::Wrapper> from C<libtext-wrapper-perl>
=back
=cut
use Modern::Perl '2018';
use Mojo::IOLoop;
use Pod::Text;
use Getopt::Long;
use Term::ReadLine; # install Term::ReadLine::Gnu
use Term::ANSIColor qw(colorstrip colored);
use URI::Escape qw(uri_escape uri_unescape);
use Encode::Locale;
use Encode qw(decode_utf8 encode_utf8 decode encode);
use Text::Wrapper;
use File::Slurper qw(read_text write_text);
use IPC::Open2;
use utf8;
my $cert;
my $key;
my $help;
script/ijirait view on Meta::CPAN
if ($shell_command) {
open(my $fh, $shell_command)
or die "Can't run $shell_command: $!";
$bytes =~ s/^2.*\n//; # skip header
print $fh $bytes;
} else {
my $text = to_text(decode_utf8($bytes));
print encode(locale => $text);
}
if ($bytes =~ m!^30 /play/ijirait(?:/([a-z]+))?(?:\?(.*))?!) {
my $command = ($1 || "look") . ($2 ? " " . decode_utf8 uri_unescape($2) : "");
$command =~ s/[[:cntrl:]]+//g;
push(@queue, $command);
}});
# Write request to the server
say "$talk_url?$command" if $verbose;
$command =~ s/\\\\/\n/g;
my $bytes = uri_escape(encode_utf8($command));
$stream->write("$talk_url?$bytes\r\n")});
# Start event loop if necessary
Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
# Add to history
$term->addhistory($_) if /\S/;
}
}
sub to_text {
my $text = shift;
script/titan view on Meta::CPAN
for my $file (@files) {
open(my $fh, '<', $file) or die "âš The file '$file' cannot be read: $!\n";
my $data = <$fh>;
close($fh);
my $size = length($data);
my $type = $mime;
$type //= qx(/usr/bin/file --mime-type --brief "$file");
$type =~ s/\s+$//; # remove trailing whitespace
# If the URL ends in a slash, append the URI-escaped filename without suffix
my $furl = $url;
if ($path =~ /\/$/) {
my ($name) = fileparse($file, '.gmi');
$furl .= uri_escape($name);
}
# create client
my $socket = IO::Socket::SSL->new(%args)
or die "Cannot construct client socket: $@";
# send data in one go
print $socket "$furl;size=$size;mime=$type;token=$token\r\n$data";
# print response
t/Galleries.t view on Meta::CPAN
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use open ':std', ':encoding(utf8)';
use Modern::Perl;
use Mojo::Util qw(url_escape);
use Encode qw(encode_utf8 decode_utf8);
use Test::More;
use File::Slurper qw(read_text write_text);
use utf8;
our @use = qw(Galleries);
our @config = (<<'EOF');
package App::Phoebe::Galleries;
use App::Phoebe qw($server);
our $galleries_dir = "$server->{wiki_dir}/galleries";
t/Galleries.t view on Meta::CPAN
like($page, qr/^# Galleries/m, "Main title");
like($page, qr/^=> $base\/do\/gallery\/one One/m, "Link to album");
$page = query_gemini("$base/do/gallery/one");
like($page, qr/^20/, "Gallery page");
like($page, qr/^# One/m, "Gallery title");
like($page, qr/^Grapsus grapsus atop a marine iguana/m, "First image title");
like($page, qr/^=> $base\/do\/gallery\/one\/thumbs\/P3111203.jpg Thumbnail/m, "First thumbnail");
like($page, qr/^=> $base\/do\/gallery\/one\/imgs\/P3111203.jpg Image/m, "First image");
my $encoded_file = url_escape encode_utf8 "hëad space.jpg";
# the second image has no title
like($page, qr/^=> $base\/do\/gallery\/one\/imgs\/$encoded_file Image/m, "Second image");
like($page, qr/^=> $base\/do\/gallery\/one\/thumbs\/$encoded_file Thumbnail/m, "Second thumbnail");
$page = query_gemini("$base/do/gallery/one/thumbs/P3111203.jpg");
like($page, qr/^20 image\/jpeg/, "First image response served");
like($page, qr/^TEST/m, "First image data served");
$page = decode_utf8 query_gemini("$base/do/gallery/one/thumbs/$encoded_file");
t/Oddmuse.t view on Meta::CPAN
qr(^10)m, "Token required");
like(query_gemini("$base/do/comment/2021-06-28?lalala"),
qr(^59)m, "Wrong token");
like(query_gemini("$base/do/comment/2021-06-28?hello"),
qr(^10)m, "Input required");
$haiku = <<EOT;
The+city cries but
Our metal worms dig deeper
Every day, alas.
EOT
like(query_gemini("$base/do/comment/2021-06-28?" . uri_escape($haiku)),
qr(^30 $base/page/Comments_on_2021-06-28)m, "Redirect");
like(query_gemini("$base/page/Comments_on_2021-06-28"),
qr(The city cries), "Comment saved, plusses handled");
# Unit testing of text formatting rules
ok(require App::Phoebe, "load phoebe");
ok(require App::Phoebe::Oddmuse, "load oddmuse.pl");
$page = App::Phoebe::Oddmuse::oddmuse_gemini_text(undef, $host, "", "Testing [Foo:Bar baz]");
t/WebComments.t view on Meta::CPAN
$page = query_web("GET /do/comment/Comments%20on%20Hello HTTP/1.0\r\n"
. "host: $host:$port");
like($page, qr/<form method="POST">/, "Form to leave a comment");
my $haiku = <<EOT;
In my shelf are books
of imaginary worlds
dusty and unread
EOT
my $content = "comment=" . uri_escape_utf8("```\n$haiku```");
my $length = length($content);
$page = query_web("POST /do/comment/Comments%20on%20Hello HTTP/1.0\r\n"
. "host: $host:$port\r\n"
. "content-type: application/x-www-form-urlencoded\r\n"
. "content-length: $length\r\n"
. "\r\n"
. $content);
like($page, qr/^HTTP\/1.1 400 Bad Request/, "Token required");
like($page, qr/^Token required/m, "Token required error");
$content = "comment=" . uri_escape_utf8("```\n$haiku```") . "&token=lalala";
$length = length($content);
$page = query_web("POST /do/comment/Comments%20on%20Hello HTTP/1.0\r\n"
. "host: $host:$port\r\n"
. "content-type: application/x-www-form-urlencoded\r\n"
. "content-length: $length\r\n"
. "\r\n"
. $content);
like($page, qr/^HTTP\/1.1 400 Bad Request/, "Wrong Token");
like($page, qr/^Wrong token/m, "Wrong token error");
$content = "comment=" . uri_escape_utf8("```\n$haiku```") . "&token=hello";
$length = length($content);
$page = query_web("POST /do/comment/Comments%20on%20Hello HTTP/1.0\r\n"
. "host: $host:$port\r\n"
. "content-type: application/x-www-form-urlencoded\r\n"
. "content-length: $length\r\n"
. "\r\n"
. $content);
like($page, qr/^HTTP\/1.1 302 Found/, "Redirect after save");
# Retry with credentials
$dav->credentials(-user => "alex", -pass => "hello", -realm => "Phoebe");
ok($dav->put(-local=>\$str, -url=>"https://$host:$port/raw/M%C3%B6%C3%B6n"),
"Post gemtext with token");
# /raw
$resource = $dav->propfind(-url=>"/raw", -depth=>1);
ok($resource && $resource->is_collection, "Found /raw");
@list = $resource->get_resourcelist->get_resources;
$item = first { decode_utf8(uri_unescape($_->get_uri->path)) eq "/raw/Möön" } @list;
ok($item && !$item->is_collection, "Found /raw/Moon");
$str = undef;
$dav->get(-url=>"/raw/M%C3%B6%C3%B6n", -to=>\$str);
like($str, qr/^Ganymede/, "Moon retrieved");
# /page
$resource = $dav->propfind(-url=>"/page", -depth=>1);
ok($resource && $resource->is_collection, "Found /page");
@list = $resource->get_resourcelist->get_resources;
$item = first { decode_utf8(uri_unescape($_->get_uri->path)) eq "/page/Möön" } @list;
ok($item && !$item->is_collection, "Found /page/Moon.html");
$str = undef;
$dav->get(-url=>"/page/M%C3%B6%C3%B6n", -to=>\$str);
like($str, qr/<p>Ganymede/, "Moon retrieved");
# delete page
$resource = $dav->delete(-url=>"/raw/M%C3%B6%C3%B6n");
$resource = $dav->propfind(-url=>"/raw", -depth=>1);
@list = $resource->get_resourcelist;
is(1, scalar(@list), "No more pages"); # just /raw itself
# Write a page
$str = "Callisto\n";
ok($dav->put(-local=>\$str, -url=>"https://$host:$port/test/raw/M%C3%B6%C3%B6n"),
"Post gemtext with token");
# /raw
$resource = $dav->propfind(-url=>"/test/raw", -depth=>1);
ok($resource && $resource->is_collection, "Found /test/raw");
@list = $resource->get_resourcelist->get_resources;
$item = first { decode_utf8(uri_unescape($_->get_uri->path)) eq "/test/raw/Möön" } @list;
ok($item && !$item->is_collection, "Found /test/raw/Moon.gmi");
$str = undef;
$dav->get(-url=>"/test/raw/M%C3%B6%C3%B6n", -to=>\$str);
like($str, qr/^Callisto/, "Moon retrieved");
# /page
$resource = $dav->propfind(-url=>"/test/page", -depth=>1);
ok($resource && $resource->is_collection, "Found /test/page");
@list = $resource->get_resourcelist->get_resources;
$item = first { decode_utf8(uri_unescape($_->get_uri->path)) eq "/test/page/Möön" } @list;
ok($item && !$item->is_collection, "Found /test/page/Moon.html");
$str = undef;
$dav->get(-url=>"/test/page/M%C3%B6%C3%B6n", -to=>\$str);
like($str, qr/<p>Callisto/, "Moon retrieved");
# copy page
$resource = $dav->copy(-url=>"/test/raw/M%C3%B6%C3%B6n", -dest=>"/raw/M%C3%B6%C3%B6n");
$resource = $dav->propfind(-url=>"/raw", -depth=>1);
ok($resource && $resource->is_collection, "Found /raw");
@list = $resource->get_resourcelist->get_resources;
$item = first { decode_utf8(uri_unescape($_->get_uri->path)) eq "/raw/Möön" } @list;
ok($item && !$item->is_collection, "Found /raw/Moon.gmi");
$str = undef;
$dav->get(-url=>"/raw/M%C3%B6%C3%B6n", -to=>\$str);
like($str, qr/^Callisto/, "Moon retrieved");
# delete page
$resource = $dav->delete(-url=>"/test/raw/M%C3%B6%C3%B6n");
$resource = $dav->propfind(-url=>"/test/raw", -depth=>1);
@list = $resource->get_resourcelist;
is(1, scalar(@list), "No more pages"); # just /test/raw itself
is(1, scalar(@list), "No more files"); # just /test/file itself
# move page
$resource = $dav->move(-url=>"/raw/M%C3%B6%C3%B6n", -dest=>"/test/raw/M%C3%B6%C3%B6n");
$resource = $dav->propfind(-url=>"/raw", -depth=>1);
@list = $resource->get_resourcelist;
is(1, scalar(@list), "No more pages"); # just /raw itself
$resource = $dav->propfind(-url=>"/test/raw", -depth=>1);
ok($resource && $resource->is_collection, "Found /test/raw");
@list = $resource->get_resourcelist->get_resources;
$item = first { decode_utf8(uri_unescape($_->get_uri->path)) eq "/test/raw/Möön" } @list;
ok($item && !$item->is_collection, "Found /test/raw/Moon.gmi");
$str = undef;
$dav->get(-url=>"/test/raw/M%C3%B6%C3%B6n", -to=>\$str);
like($str, qr/^Callisto/, "Moon retrieved");
done_testing();
t/WebEdit.t view on Meta::CPAN
$page = query_web("GET /do/edit/Hello HTTP/1.0\r\n"
. "host: $host:$port");
like($page, qr/^HTTP\/1.1 200 OK/, "Edit page served via HTTP");
my $haiku = <<EOT;
The laptop streaming
videos of floods and rain
but I hear sparrows
EOT
my $content = "text=" . uri_escape_utf8("```\n$haiku```");
my $length = length($content);
$page = query_web("POST /do/edit/Hello HTTP/1.0\r\n"
. "host: $host:$port\r\n"
. "content-type: application/x-www-form-urlencoded\r\n"
. "content-length: $length\r\n"
. "\r\n"
. $content);
like($page, qr/^HTTP\/1.1 400 Bad Request/, "Token required");
like($page, qr/^Token required/m, "Token required error");
$content = "text=" . uri_escape_utf8("```\n$haiku```") . "&token=lalala";
$length = length($content);
$page = query_web("POST /do/edit/Hello HTTP/1.0\r\n"
. "host: $host:$port\r\n"
. "content-type: application/x-www-form-urlencoded\r\n"
. "content-length: $length\r\n"
. "\r\n"
. $content);
like($page, qr/^HTTP\/1.1 400 Bad Request/, "Wrong Token");
like($page, qr/^Wrong token/m, "Wrong token error");
$content = "text=" . uri_escape_utf8("```\n$haiku```") . "&token=hello";
$length = length($content);
$page = query_web("POST /do/edit/Hello HTTP/1.0\r\n"
. "host: $host:$port\r\n"
. "content-type: application/x-www-form-urlencoded\r\n"
. "content-length: $length\r\n"
. "\r\n"
. $content);
like($page, qr/^HTTP\/1.1 302 Found/, "Redirect after save");
t/encoding.t view on Meta::CPAN
our $base;
our $dir;
require './t/test.pl';
# upload text
my $titan = "titan://$hosts[0]:$port";
my $name = "日本語";
my $encoded_name = uri_escape_utf8($name);
my $text = <<EOT;
Schröder answered: ｢郵便局｣
EOT
my $encoded_text = encode_utf8($text);
my $length = length($encoded_text);
my $page = query_gemini("$titan/raw/$encoded_name;size=$length;mime=text/plain;token=hello", $encoded_text);
like($page, qr/^30 $base\/page\/$encoded_name\r$/, "Titan Text");
$page = query_gemini("$base/page/$encoded_name");
( run in 1.342 second using v1.01-cache-2.11-cpan-c21f80fb71c )