#!/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 . 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", # mIRC colors WHITE => "\x0300", BLUE => "\x0302", RED => "\x0304", BROWN => "\x0305", PURPLE => "\x0306", YELLOW => "\x0308", LIGHT_GREEN => "\x0309", TEAL => "\x0310", PINK => "\x0313", }; { # 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 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. ); my %colors = ( 0 => RED, 1 => YELLOW, 2 => BROWN, 3 => LIGHT_GREEN, 4 => TEAL, 5 => BLUE, 6 => PURPLE, 7 => PINK, ); # 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;