view release on metacpan or  search on metacpan

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

# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

App::Phoebe::Chat - add a Gemini-based chat room for every Phoebe wiki space

=head1 DESCRIPTION

For every wiki space, this creates a Gemini-based chat room. Every chat client
needs two URLs, the "listen" and the "say" URL.

The I<Listen URL> is where you need to I<stream>: as people say things in the
room, these messages get streamed in one endless Gemini document. You might have
to set an appropriate timeout period for your connection for this to work. 1h,
perhaps?

The URL will look something like this:
C<gemini://localhost/do/chat/listen> or
C<gemini://localhost/space/do/chat/listen>

The I<Say URL> is where you post things you want to say: point your client at
the URL, it prompts your for something to say, and once you do, it redirects you
to the same URL again, so you can keep saying things.

The URL will look something like this: C<gemini://localhost/do/chat/say> or
C<gemini://localhost/space/do/chat/say>

Your chat nickname is the client certificate's common name. One way to create a
client certificate that's valid for five years with an appropriate common name:

    openssl req -new -x509 -newkey ec \
    -pkeyopt ec_paramgen_curve:prime256v1 \
    -subj '/CN=Alex' \
    -days 1825 -nodes -out cert.pem -keyout key.pem

There is no configuration. Simply add it to your F<config> file:

    use App::Phoebe::Chat;

As a user, first connect using a client that can stream:

    gemini --cert_file=cert.pem --key_file=key.pem \
      gemini://localhost/do/chat/listen

Then connect with a client that let's you post what you type:

    gemini-chat --cert_file=cert.pem --key_file=key.pem \
      "gemini://localhost/do/chat/say"

=cut

package App::Phoebe::Chat;
use App::Phoebe qw(@extensions @request_handlers $log
		   success result port space host_regex space_regex);
use Modern::Perl '2018';
use Encode qw(decode_utf8 encode_utf8);
use URI::Escape;
use utf8;

# Each chat member is {stream => $stream, host => $host, space => $space, name => $name}
my (@chat_members, @chat_lines);
my $chat_line_limit = 50;

# needs a special handler because the stream never closes
my $spaces = space_regex();
unshift(@request_handlers, '^gemini://([^/?#]*)(?:/$spaces)?/do/chat/listen' => \&chat_listen);

sub chat_listen {
  my $stream = shift;
  my $data = shift;
  $log->debug("Handle chat listen request");
  $log->debug("Discarding " . length($data->{buffer}) . " bytes")
      if $data->{buffer};
  my $url = $data->{request};
  my $hosts = host_regex();
  my $spaces = space_regex();
  my $port = port($stream);
  my ($host, $space);
  if (($host, $space) =
      $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/chat/listen$!) {
    chat_register($stream, $host, $port, space($stream, $host, $space) || '');
    # don't lose the stream!
  } else {
    result($stream, "59", "Don't know how to handle $url");
    $stream->close_gracefully();
  }
}

sub chat_register {
  my $stream = shift;
  my $host = shift;
  my $port = shift;
  my $space = shift;
  my $name = $stream->handle->peer_certificate('cn');
  if (not $name) {
    result($stream, "60", "You need a client certificate with a common name to listen to this chat");
    $stream->close_gracefully();
    return;
  }
  if (grep { $host eq $_->{host} and $space eq $_->{space} and $name eq $_->{name} } @chat_members) {
    result($stream, "40", "'$name' is already taken");
    $stream->close_gracefully();
    return;
  }
  # 1h timeout
  $stream->timeout(3600);
  # remove from channel members if an error happens
  $stream->on(close => sub { chat_leave($host, $space, $name) });
  $stream->on(error => sub { chat_leave($host, $space, $name) });
  # add myself
  push(@chat_members, { host => $host, space => $space, name => $name, stream => $stream });
  # announce myself
  my @names;
  for (@chat_members) {
    next unless $host eq $_->{host} and $space eq $_->{space} and $name ne $_->{name};