App-Phoebe
view release on metacpan or search on metacpan
- Add colour styles to history and diff (behind a link).
4.01
- It's now App::Phoebe instead of App::phoebe.
- App::Phoebe::RegisteredEditorsOnly now works if you use
App::Phoebe::WebEdit.
- App::Phoebe::Ijirait has a backup command to allow players to
download the world data (without fingerprints); the rooms command
now allows you to list ghosts (inactive characters).
- Both ijirait and titan scripts no longer use --url= as there is
exactly one URL and it is mandatory.
- App::Phoebe::Gopher no longer prints links for plain text pages.
- App::Phoebe::WebStaticFiles is new.
lib/App/Phoebe/Capsules.pm view on Meta::CPAN
=head1 TROUBLESHOOTING
🔥 In the wiki directory, you can have a file called F<fingerprint_equivalents>.
Its main use is to allow people to add more fingerprints for their site, such as
from other devices or friends. The file format is line oriented, each line
containing two fingerprints, C<FROM> and C<TO>.
🔥 The capsule name I<login> is reserved.
🔥 The file names I<archive>, I<backup>, and I<upload> are reserved.
=head1 NO WIKI, ONLY CAPSULES
Here's how to disable all wiki functions of Phoebe and just use capsules. The
C<nothing_else> function comes right after C<capsules> as an extension and
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>).
lib/App/Phoebe/Capsules.pm view on Meta::CPAN
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);
lib/App/Phoebe/Capsules.pm view on Meta::CPAN
}
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);
$stream->write(read_binary($file));
} else {
$log->info("Backup for $capsule");
success($stream);
$stream->write("# " . ucfirst($capsule) . " backup\n");
$stream->write("When editing a page, a backup is saved here as long as at least 10 minutes have passed.\n");
my @files;
@files = read_dir($dir) if -d $dir;
if (not @files) {
$stream->write("There are no backup files, yet.\n") unless @files;
} else {
$stream->write("Files:\n");
for my $file (sort @files) {
print_link($stream, $host, $capsule_space, $file, "$capsule/backup/$file");
};
}
}
return 1;
}
sub serve_capsule_delete {
my ($stream, $host, $capsule, $id) = @_;
my $name = capsule_name($stream);
return 1 unless is_my_capsule($stream, $name, $capsule, 'delete a file in');
my $dir = capsule_dir($host, $capsule);
if ($id) {
$log->info("Delete $id from $capsule");
my $file = $dir . "/" . encode_utf8($id);
my $backup_dir = "$dir/backup";
my $backup_file = $backup_dir . "/" . encode_utf8($id);
mkdir($backup_dir) unless -d $backup_dir;
rename $file, $backup_file if -f $file;
result($stream, "30", to_url($stream, $host, $capsule_space, $capsule));
} else {
$log->info("Delete for $capsule");
success($stream);
$stream->write("# Delete a file in " . ucfirst($capsule) . "\n");
$stream->write("Deleting a file moves it to the backup.\n");
my @files;
@files = grep { $_ ne "backup" } read_dir($dir) if -d $dir;
if (not @files) {
$stream->write("There are no files to delete.\n") unless @files;
} else {
$stream->write("Files:\n");
for my $file (sort @files) {
print_link($stream, $host, $capsule_space, $file, "$capsule/delete/$file");
};
}
}
return 1;
lib/App/Phoebe/Capsules.pm view on Meta::CPAN
}
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");
}
lib/App/Phoebe/Capsules.pm view on Meta::CPAN
my $dir = capsule_dir($host, $capsule);
my $id = $upload->{id};
my $file = $dir . "/" . encode_utf8($id);
if ($size == 0) {
return result($stream, "51", "This capsule does not exist") unless -d $dir;
return result($stream, "51", "This file does not exist") unless -f $file;
return result($stream, "40", "Cannot delete this file") unless unlink $file;
$log->info("Deleted $file");
} else {
mkdir($dir) unless -d $dir;
backup($dir, $id);
write_binary($file, $buffer);
$log->info("Wrote $file");
return result($stream, "30", to_url($stream, $host, $capsule_space, $capsule));
}
}
sub backup {
my ($dir, $id) = @_;
my $file = $dir . "/" . encode_utf8($id);
my $backup_dir = "$dir/backup";
my $backup_file = $backup_dir . "/" . encode_utf8($id);
return unless -f $file and (time - (stat($file))[9]) > 600;
# make a backup if the last edit was more than 10 minutes ago
mkdir($backup_dir) unless -d $backup_dir;
write_binary($backup_file, read_binary($file));
}
1;
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
Mojo::IOLoop->next_tick(sub {
$log->info("Serving Ijirait on $host") });
# global commands
our $commands = {
help => \&help,
look => \&look,
type => \&type,
save => \&save,
backup => \&backup,
export => \&export,
say => \&speak, # can't use say!
who => \&who,
go => \&go,
examine => \&examine,
describe => \&describe,
name => \&name,
create => \&create,
delete => \&delete,
rooms => \&rooms,
lib/App/Phoebe/Ijirait.pm view on Meta::CPAN
for my $room (@{$data->{rooms}}) {
my @words;
for my $word (@{$room->{words}}) {
next if $now - $word->{ts} > 600; # don't show messages older than 10min
push(@words, $word);
}
$room->{words} = \@words;
}
}
sub backup() {
my $stream = shift;
my $bytes = encode_json $data;
$bytes =~ s/"fingerprint":"[^"]+"/"fingerprint":""/g;
success($stream, "application/json+gzip");
$stream->write(gzip $bytes);
}
sub who {
my ($stream) = @_;
my $now = time;
t/Capsules.t view on Meta::CPAN
like($page, qr/^30 $base\/capsule\/$name/m, "Redirect to the same capsule");
ok(-f "$dir/fingerprint_equivalents", "Fingerprint equivalents saved");
like(read_text("$dir/fingerprint_equivalents"), qr/^sha256\S+ sha256\S+$/, "Fingerprint equivalents");
# testing the fingerprint equivalency
$page = query_gemini("$base/capsule/$name", undef, 2);
like($page, qr/# $name/mi, "Title");
like($page, qr/^=> $base\/capsule\/$name\/upload/m, "Equivalent upload link");
# test backup
ok(! -d "$dir/capsule/$name/backup", "No backup dir has been created");
ok(! -f "$dir/capsule/$name/backup/haiku.gmi", "No backup has been made");
my $ts = time - 1000;
is(utime($ts, $ts, "$dir/capsule/$name/haiku.gmi"), 1, "File backdated");
$haiku = <<"EOT";
Nervous late at night
Typing furiously, in vain
There's always a bug
EOT
$page = query_gemini("$titan/$name/haiku.gmi;size=69;mime=text/plain", $haiku);
like($page, qr/^30 $base\/capsule\/$name/, "Saved haiku");
ok(-d "$dir/capsule/$name/backup", "Backup dir has been created");
ok(-f "$dir/capsule/$name/backup/haiku.gmi", "Backup has been made");
like(read_text("$dir/capsule/$name/haiku.gmi"), qr/Nervous late at night/, "File saved");
like(read_text("$dir/capsule/$name/backup/haiku.gmi"), qr/On the red sofa/, "Backup saved");
$page = query_gemini("$base/capsule/$name/haiku.gmi");
like($page, qr/Nervous late at night/, "Current page");
$page = query_gemini("$base/capsule/$name/backup/haiku.gmi");
like($page, qr/On the red sofa/, "Backup page");
SKIP: {
-x '/bin/tar' or skip "Missing /bin/tar on this system";
qx'/bin/tar --version' =~ /GNU tar/ or skip "No GNU tar on this system";
$page = query_gemini("$base/capsule/$name/archive");
like($page, qr/^20 application\/tar\r\n/m, "Download tar file");
$page =~ s/^20 application\/tar\r\n//;
my $tar = read_binary("$dir/capsule/$name/backup/data.tar.gz");
ok($tar eq $page, "tar bytes are correct");
open(my $fh, "tar --list --gzip --file $dir/capsule/$name/backup/data.tar.gz |");
my @files = <$fh>;
close($fh);
ok((first { "$name/haiku.gmi\n" } @files), "Found haiku in the archive");
ok((grep !/backup/, @files), "No backups in the archive (@files)");
}
# upload to the wrong place
$page = query_gemini("$titan/$name;size=69;mime=text/plain", $haiku);
like($page, qr/^59 The titan URL is missing the file name/, "Missing file name");
# Missing extension
$page = query_gemini("$titan/$name/no-extension;size=69;mime=text/plain", $haiku);
t/Capsules.t view on Meta::CPAN
$page = query_gemini("$base/capsule/$name/delete");
like($page, qr/^# Delete a file in $name/mi, "Deleting page header");
like($page, qr/^=> $base\/capsule\/$name\/delete\/haiku\.gmi/m, "Deleting page menu");
$page = query_gemini("$base/capsule/$name/delete/haiku.gmi");
like($page, qr/^30 $base\/capsule\/$name\r\n/, "Redirect after delete");
$page = query_gemini("$base/capsule/$name");
unlike($page, qr/haiku\.gmi/, "File listed");
$page = query_gemini("$base/capsule/$name/delete");
like($page, qr/^There are no files to delete/m, "No more files to delete");
ok(! -f "$dir/capsule/$name/haiku.gmi", "File is gone");
like(read_text("$dir/capsule/$name/backup/haiku.gmi"), qr/Nervous late at night/, "Backup saved");
done_testing;
( run in 1.311 second using v1.01-cache-2.11-cpan-49f99fa48dc )