view release on metacpan or  search on metacpan

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

=head1 NAME

App::Phoebe - a Gemini-based wiki

=head1 DESCRIPTION

This module contains the core of the Phoebe wiki. Import functions and variables
from this module to write extensions, or to run it some other way. Usually,
F<script/phoebe> is used to start a Phoebe server. This is why all the
documentation regarding server startup can be found there.

This section describes some hooks you can use to customize your wiki using the
F<config> file, or using a Perl file (ending in F<*.pl> or F<*.pm>) in the
F<conf.d> directory. Once you're happy with the changes you've made, restart the
server, or send a SIGHUP if you know the PID.

Here are the ways you can hook into Phoebe code:

C<@extensions> is a list of code references allowing you to handle additional
URLs; return 1 if you handle a URL; each code reference gets called with $stream
(L<Mojo::IOLoop::Stream>), the first line of the request (a Gemini URL, a Gopher
selector, a finger user, a HTTP request line), a hash reference for the headers
(in the case of HTTP requests), and a buffer of bytes (e.g. for Titan or HTTP
PUT or POST requests).

C<@main_menu> adds more lines to the main menu, possibly links that aren't
simply links to existing pages.

C<@footer> is a list of code references allowing you to add things like licenses
or contact information to every page; each code reference gets called with
$stream (L<Mojo::IOLoop::Stream>), $host, $space, $id, $revision, and $format
('gemini' or 'html') used to serve the page; return a gemtext string to append
at the end; the alternative is to overwrite the C<footer> or C<html_footer> subs
– the default implementation for Gemini adds History, Raw text and HTML link,
and C<@footer> to the bottom of every page; the default implementation for HTTP
just adds C<@footer> to the bottom of every page.

If you do hook into Phoebe's code, you probably want to make use of the
following variables:

C<$server> stores the command line options provided by the user.

C<$log> is how you log things.

A very simple example to add a contact mail at the bottom of every page; this
works for both Gemini and the web:

    # tested by t/example-footer.t
    use App::Phoebe::Web;
    use App::Phoebe qw(@footer);
    push(@footer, sub { '=> mailto:alex@alexschroeder.ch Mail' });

This prints a very simply footer instead of the usual footer for Gemini, as the
C<footer> function is redefined. At the same time, the C<@footer> array is still
used for the web:

    # tested by t/example-footer2.t
    package App::Phoebe;
    use App::Phoebe::Web;
    use Modern::Perl;
    our (@footer); # HTML only
    push(@footer, sub { '=> https://alexschroeder.ch/wiki/Contact Contact' });
    # footer sub is Gemini only
    no warnings qw(redefine);
    sub footer {
      return "\n" . '—' x 10 . "\n" . '=> mailto:alex@alexschroeder.ch Mail';
    }

This example shows you how to add a new route (a new path served by the wiki).
Instead of just writing "Test" to the page, you could of course run arbitrary
Perl code.

    # tested by t/example-route.t
    our @config = (<<'EOT');
    use App::Phoebe qw(@extensions @main_menu port host_regex success);
    use Modern::Perl;
    push(@main_menu, "=> /do/test Test");
    push(@extensions, \&serve_test);
    sub serve_test {
      my $stream = shift;
      my $url = shift;
      my $hosts = host_regex();
      my $port = port($stream);
      if ($url =~ m!^gemini://($hosts):$port/do/test$!) {
	success($stream, 'text/plain; charset=UTF-8');
	$stream->write("Test\n");
	return 1;
      }
      return;
    }
    EOT

This example also shows how to redefine existing code in your config file
without the warning "Subroutine … redefined".

Here's a more elaborate example to add a new action the main menu and a handler
for it, for Gemini only:

    # tested by t/example-new-action.t
    package App::Phoebe;
    use Modern::Perl;
    our (@extensions, @main_menu);
    push(@main_menu, "=> gemini://localhost/do/test Test");
    push(@extensions, \&serve_test);
    sub serve_test {
      my $stream = shift;
      my $url = shift;
      my $headers = shift;
      my $host = host_regex();
      my $port = port($stream);
      if ($url =~ m!^gemini://($host)(?::$port)?/do/test$!) {
	result($stream, "20", "text/plain");
	$stream->write("Test\n");
	return 1;
      }
      return;
    }
    1;

=cut

package App::Phoebe;
use Modern::Perl '2018';
use File::Slurper qw(read_text read_binary read_lines read_dir write_text write_binary);
use Encode qw(encode_utf8 decode_utf8);
use Net::IDN::Encode qw(domain_to_ascii);
use Socket qw(:addrinfo SOCK_RAW);
use List::Util qw(first min any);
use File::ReadBackwards;
use Algorithm::Diff;
use URI::Escape;
use Mojo::IOLoop;
use Mojo::Log;
use utf8;

our $VERSION = 4.00;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(@extensions @main_menu @footer $log $server $full_url_regex
		    space port host_regex space_regex reserved_regex success
		    result get_ip_numbers run_extensions pages blog blog_pages
		    text save_page serve_index serve_page serve_raw serve_html
		    serve_history serve_diff html_page to_html @request_handlers
		    handle_request process_titan process_gemini valid_id
		    valid_mime_type valid_size valid_token print_link all_logs
		    gemini_link colourize modified changes diff bogus_hash
		    quote_html write_page @known_fingerprints with_lock wiki_dir
		    to_url handle_titan footer atom rss files space_links search);

# Phoebe variables you can set in the config file

our (@extensions, @main_menu, @footer);
our $log ||= Mojo::Log->new(level => 'warn');
our $server = {host => {}};

our $protocols = 'https?|ftp|afs|news|nntp|mid|cid|mailto|wais|prospero|telnet|gophers?|irc|feed|gemini|xmpp';
our $chars = '[-a-zA-Z0-9/@=+$_~*.,;:?!\'"()&#%]'; # see RFC 2396
our $full_url_regex = "((?:$protocols):$chars+)";

our @known_fingerprints; # only used by extensions

# Conventions:
# - a regular exression on the first line of the request
# - a handle_foo sub to do wait until you're ready (take $stream and $data,
#   where $data->{buffer} keeps growing with bytes)
# - a process_foo sub to finish the job and write stuff back to the $stream

our @request_handlers = (
  '^titan://' => \&handle_titan,
  '^gemini://' => \&handle_gemini,
  '^[^:/?#]+://([^/?#]*)([^?#]*)(?:\?([^#]*))?(?:#(.*))?$' => \&handle_url,
);

# Phoebe subroutines you might want to call in your extensions

sub port {
  my $stream = shift;
  return 1965 unless $stream; # if called in a test situation
  return $stream->handle->sockport; # the actual port
}

sub get_ip_numbers {