368 lines
10 KiB
Perl
Executable file
368 lines
10 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
# Copyright (C) 2024 jjakke@sqt.wtf
|
|
#
|
|
# This program is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation, either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# 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 <https://www.gnu.org/licenses/>.
|
|
|
|
use Mojolicious::Lite -signatures;
|
|
use Mojo::JSON qw(decode_json);
|
|
use Mojo::UserAgent;
|
|
use Mojo::IRC;
|
|
use Carp qw(croak);
|
|
use Smart::Comments;
|
|
use MIME::Base64 qw(encode_base64);
|
|
## no critic (prototype)
|
|
|
|
our $VERSION = '0.2'; # not 100% stress tested
|
|
|
|
my $streaming_RN = 0;
|
|
my $stream_stop_time = 0;
|
|
my $owncast_chat_closes = 60 * 5; # 5 minutes
|
|
|
|
# yoinked from IRC::Utils
|
|
use constant {
|
|
# cancel all formatting and colors
|
|
NORMAL => "\x0f", # 0
|
|
|
|
# formatting
|
|
BOLD => "\x02", # 1
|
|
UNDERLINE => "\x1f", # 2
|
|
REVERSE => "\x16", # 3
|
|
ITALIC => "\x1d", # 4
|
|
FIXED => "\x11", # 5
|
|
BLINK => "\x06", # 6
|
|
|
|
# mIRC colors
|
|
WHITE => "\x0300", # 7
|
|
BLACK => "\x0301", # 8
|
|
BLUE => "\x0302", # 9
|
|
GREEN => "\x0303", # 10
|
|
RED => "\x0304", # 11
|
|
BROWN => "\x0305", # 12
|
|
PURPLE => "\x0306", # 13
|
|
ORANGE => "\x0307", # 14
|
|
YELLOW => "\x0308", # 15
|
|
LIGHT_GREEN => "\x0309", # 16
|
|
TEAL => "\x0310", # 17
|
|
LIGHT_CYAN => "\x0311", # 18
|
|
LIGHT_BLUE => "\x0312", # 19
|
|
PINK => "\x0313", # 20
|
|
GREY => "\x0314", # 21
|
|
LIGHT_GREY => "\x0315", # 22
|
|
};
|
|
|
|
my %colors = (
|
|
0 => RED,
|
|
1 => YELLOW,
|
|
2 => BROWN,
|
|
3 => LIGHT_GREEN,
|
|
4 => TEAL,
|
|
5 => BLUE,
|
|
6 => PURPLE,
|
|
7 => PINK,
|
|
);
|
|
|
|
{
|
|
# OWNCAST_URL: should not have '/' at end, eg 'http://hostname'
|
|
my $death_string = '';
|
|
for my $e (qw(OWNCAST_ACCESS_TOKEN OWNCAST_URL IRC_CHANNEL IRC_NICK IRC_USER IRC_SERVER))
|
|
{
|
|
exists $ENV{ $e }
|
|
or $death_string .= "environment variable missing: $e\n";
|
|
}
|
|
croak $death_string if ($death_string);
|
|
}
|
|
|
|
my $ua = Mojo::UserAgent->new; # for sending messages to Owncast
|
|
my $irc = Mojo::IRC->new(
|
|
nick => $ENV{ IRC_NICK },
|
|
user => $ENV{ IRC_USER },
|
|
server => $ENV{ IRC_SERVER },
|
|
);
|
|
|
|
# there's no /quit event (or if there is, author failed to document it)
|
|
# susceptible to abuse
|
|
$irc->on(message => sub ($self, $message) {
|
|
### $message
|
|
my $command = $message->{command};
|
|
if ($command eq 'QUIT') {
|
|
my @name = split '!', $message->{prefix};
|
|
send_system_chat_to_owncast("$name[0] has quit");
|
|
delete_owncast_access_token($name[0]);
|
|
}
|
|
});
|
|
|
|
$irc->on(irc_privmsg => sub ($self, $message) {
|
|
if ($message->{params}[0] eq $ENV{ IRC_CHANNEL }) {
|
|
my @name = split '!', $message->{prefix};
|
|
#say $name[0] . " said: " . $message->{params}[1];
|
|
# ACTION in owncast chat is ugly
|
|
$message->{params}[1] =~ s|^\x01ACTION|/me|; # ty for the \x01 hint, Irish
|
|
|
|
# strip IRC codes because owncast seems to treat it as emoji
|
|
for my $irc_code (NORMAL, BOLD, UNDERLINE, REVERSE, ITALIC, FIXED, BLINK)
|
|
{
|
|
$message->{params}[1] =~ s|$irc_code||g;
|
|
}
|
|
$message->{params}[1] =~ s|\x03\d?\d||g; # colors
|
|
$message->{params}[1] =~ s|\x03||g; # bare color code ????
|
|
|
|
send_chat_to_owncast($message->{params}[1], $name[0]);
|
|
}
|
|
});
|
|
|
|
# susceptible to abuse
|
|
$irc->on(irc_nick => sub ($self, $message) {
|
|
my @old_name = split '!', $message->{prefix};
|
|
my $new_name = $message->{params}[0];
|
|
send_system_chat_to_owncast("$old_name[0] is now known as $new_name");
|
|
owncast_nick_change($old_name[0], $new_name);
|
|
});
|
|
|
|
$irc->on(irc_join => sub ($self, $message) {
|
|
if ($message->{params}[0] eq $ENV{ IRC_CHANNEL }) {
|
|
my @name = split '!', $message->{prefix};
|
|
send_system_chat_to_owncast("$name[0] has joined");
|
|
}
|
|
});
|
|
|
|
$irc->on(irc_part => sub ($self, $message) {
|
|
if ($message->{params}[0] eq $ENV{ IRC_CHANNEL }) {
|
|
my @name = split '!', $message->{prefix};
|
|
send_system_chat_to_owncast("$name[0] has parted");
|
|
delete_owncast_access_token($name[0]);
|
|
}
|
|
});
|
|
|
|
my %events = (
|
|
CHAT => \&chat,
|
|
NAME_CHANGED => \&name_changed,
|
|
NAME_CHANGE => \&name_changed,
|
|
USER_JOINED => \&user_joined,
|
|
USER_PARTED => \&user_parted,
|
|
STREAM_STARTED => \&stream_started,
|
|
STREAM_STOPPED => \&stream_stopped,
|
|
STREAM_TITLE_UPDATED => \&stream_title_updated,
|
|
#'VISIBILITY-UPDATE' => \&visibility-update # don't care.
|
|
);
|
|
|
|
# TODO: actually parse this. it'll do for now™, I guess. (Aug 2024)
|
|
if ($ENV{ IRC_SERVER } =~ m/:6697$/) {
|
|
$irc->tls({});
|
|
}
|
|
$irc->register_default_event_handlers;
|
|
|
|
# 15 seconds, so it can talk with the server for a bit.
|
|
Mojo::IOLoop->timer(15 => sub { $irc->write(join => $ENV{IRC_CHANNEL}) });
|
|
|
|
sub send_chat_to_irc ($body) {
|
|
my $length = length("PRIVMSG $ENV{ IRC_CHANNEL } :$body") + 50; # dunno how long hostmask is
|
|
# length allowed on IRC is 510(including hostmask) but can be hard to read.
|
|
# Owncast does \x{this} to emojis which seems to translate cleanly to IRC.
|
|
if ($length < 350) {
|
|
$irc->write('PRIVMSG' => "$ENV{ IRC_CHANNEL } :$body");
|
|
}
|
|
else {
|
|
my @body = split /\s/, $body;
|
|
my $string = '';
|
|
while (@body) {
|
|
my $word = shift @body;
|
|
$string .= " $word";
|
|
if ( (length ($string) + 50) > 300) {
|
|
$irc->write('PRIVMSG' => "$ENV{ IRC_CHANNEL } :$string");
|
|
$string = '';
|
|
}
|
|
}
|
|
# disregard probable spam
|
|
if (length ($string) < 350) {
|
|
$irc->write('PRIVMSG' => "$ENV{ IRC_CHANNEL } :$string");
|
|
$string = '';
|
|
}
|
|
}
|
|
}
|
|
|
|
my %owncast_nicks;
|
|
|
|
sub owncast_admin_pass {
|
|
exists $ENV{ OWNCAST_ADMIN_PASS_FILE }
|
|
and -r $ENV{ OWNCAST_ADMIN_PASS_FILE }
|
|
or return 0;
|
|
open my $fh, '<', $ENV{ OWNCAST_ADMIN_PASS_FILE };
|
|
my @pass = <$fh>;
|
|
close $fh;
|
|
chomp $pass[0];
|
|
return encode_base64("admin:$pass[0]", '');
|
|
}
|
|
|
|
sub delete_owncast_access_token ($nick) {
|
|
my $basic = owncast_admin_pass();
|
|
return 0 unless $basic;
|
|
my $res = $ua->post("$ENV{ OWNCAST_URL }/api/admin/accesstokens/delete" =>
|
|
{'Authorization' => "Basic $basic"} =>
|
|
json => {token => $owncast_nicks{ $nick }});
|
|
### $res
|
|
delete $owncast_nicks{ $nick };
|
|
}
|
|
|
|
sub owncast_nick_change ($old, $new) {
|
|
delete_owncast_access_token($old);
|
|
create_owncast_access_token($new);
|
|
}
|
|
|
|
sub create_owncast_access_token ($nick) {
|
|
my $basic = owncast_admin_pass();
|
|
return 0 unless $basic;
|
|
my $res = $ua->get("$ENV{ OWNCAST_URL }/api/admin/accesstokens/create" =>
|
|
{'Authorization' => "Basic $basic"} =>
|
|
json => {name => $nick, scopes => ['CAN_SEND_MESSAGES']})->result->body;
|
|
if ($res ne "Unauthorized\n") {
|
|
### $res
|
|
my $body = decode_json($res);
|
|
$owncast_nicks{ $nick } = $body->{accessToken};
|
|
return 1;
|
|
}
|
|
else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
sub get_owncast_access_token ($nick) {
|
|
my $basic = owncast_admin_pass();
|
|
return 0 unless $basic;
|
|
my $res = $ua->get("$ENV{ OWNCAST_URL }/api/admin/accesstokens" =>
|
|
{'Authorization' => "Basic $basic"})->result->body;
|
|
if ($res ne "Unauthorized\n") {
|
|
### $res
|
|
my $body = decode_json($res);
|
|
for my $hash (@{ $body }) {
|
|
$owncast_nicks{ $hash->{displayName} } = $hash->{accessToken};
|
|
}
|
|
}
|
|
else {
|
|
return 0; # broken authorization
|
|
}
|
|
exists $owncast_nicks{ $nick } ? return 1 : create_owncast_access_token($nick);
|
|
}
|
|
|
|
sub send_chat_to_owncast ($body, $nick) {
|
|
# if streaming or if chat has yet to close
|
|
if ($streaming_RN or ($stream_stop_time + $owncast_chat_closes) > time) {
|
|
if (exists $owncast_nicks{ $nick }) {
|
|
return $ua->post("$ENV{ OWNCAST_URL }/api/integrations/chat/send" =>
|
|
{'Authorization' => "Bearer $owncast_nicks{ $nick }" } =>
|
|
json => {body => $body});
|
|
}
|
|
else {
|
|
if (get_owncast_access_token($nick)) {
|
|
return $ua->post("$ENV{ OWNCAST_URL }/api/integrations/chat/send" =>
|
|
{'Authorization' => "Bearer $owncast_nicks{ $nick }" } =>
|
|
json => {body => $body});
|
|
}
|
|
}
|
|
$ua->post("$ENV{ OWNCAST_URL }/api/integrations/chat/send" =>
|
|
{'Authorization' => "Bearer $ENV{ OWNCAST_ACCESS_TOKEN }" } =>
|
|
json => {body => "\\<$nick\\> $body"});
|
|
}
|
|
}
|
|
|
|
sub send_system_chat_to_owncast ($body) {
|
|
$ua->post("$ENV{ OWNCAST_URL }/api/integrations/chat/action" =>
|
|
{'Authorization' => "Bearer $ENV{ OWNCAST_ACCESS_TOKEN }" } =>
|
|
json => {body => "$body"});
|
|
}
|
|
|
|
post '/webhook' => sub ($c) {
|
|
my $hook = decode_json($c->req->body);
|
|
### $hook
|
|
if (exists $events{$hook->{type}}) {
|
|
my $ref = $events{$hook->{type}};
|
|
$ref->($c, $hook);
|
|
}
|
|
|
|
$c->render(text => "ok", status => 200);
|
|
};
|
|
|
|
any '/' => sub ($c) {
|
|
$c->render(text => "no", status => 400);
|
|
};
|
|
|
|
any '/*' => sub ($c) {
|
|
$c->render(text => "no", status => 400);
|
|
};
|
|
|
|
# owncast /doesn't/ send AccessToken chats so thats nice (Aug 2024)
|
|
sub chat ($c, $hook) {
|
|
my $name = $hook->{eventData}->{user}->{displayName};
|
|
my $color = $hook->{eventData}->{user}->{displayColor};
|
|
my $body = $hook->{eventData}->{rawBody}; # no html
|
|
my $visible = $hook->{eventData}->{visible};
|
|
if ($visible) {
|
|
send_chat_to_irc( '<' . $colors{$color} . "$name" . NORMAL . '>' . " $body");
|
|
}
|
|
};
|
|
|
|
sub name_changed ($c, $hook) {
|
|
my $new_name = $hook->{eventData}->{newName};
|
|
my $color = $hook->{eventData}->{user}->{displayColor};
|
|
my $old_name = $hook->{eventData}->{user}->{previousNames}->[-1]; # last element is newest old name
|
|
send_chat_to_irc( $colors{$color} . "$old_name" . NORMAL ." -> " . $colors{$color} ."$new_name" . NORMAL);
|
|
};
|
|
|
|
sub user_joined ($c, $hook) {
|
|
my $name = $hook->{eventData}->{user}->{displayName};
|
|
my $color = $hook->{eventData}->{user}->{displayColor};
|
|
send_chat_to_irc($colors{$color} . $name . NORMAL . " joined the webchat");
|
|
};
|
|
|
|
sub user_parted ($c, $hook) {
|
|
my $name = $hook->{eventData}->{user}->{displayName};
|
|
# if not streaming AND webchat is still open OR currently streaming
|
|
if (((! $streaming_RN) and (($stream_stop_time + $owncast_chat_closes) > time)) or $streaming_RN) {
|
|
send_chat_to_irc("$name left the webchat");
|
|
}
|
|
};
|
|
|
|
sub stream_started ($c, $hook) {
|
|
send_chat_to_irc("The stream has started");
|
|
$streaming_RN = 1;
|
|
};
|
|
|
|
sub stream_stopped ($c, $hook) {
|
|
send_chat_to_irc("The stream has ended");
|
|
$streaming_RN = 0;
|
|
$stream_stop_time = time;
|
|
};
|
|
|
|
sub stream_title_updated ($c, $hook) {
|
|
my $title = $hook->{eventData}->{streamTitle};
|
|
send_chat_to_irc("Steam title: $title");
|
|
};
|
|
|
|
app->hook(before_server_start => sub {
|
|
$irc->connect(sub {
|
|
my($irc, $err) = @_;
|
|
croak $err if $err;
|
|
});
|
|
my $res = $ua->get("$ENV{ OWNCAST_URL }/api/status");
|
|
if ($res) {
|
|
my $online = decode_json($res->result->body)->{online};
|
|
if ($online) {
|
|
$streaming_RN = 1;
|
|
}
|
|
}
|
|
else {
|
|
croak $res;
|
|
}
|
|
});
|
|
|
|
app->start;
|