#!/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.3'; # 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 ???? $message->{params}[1] =~ s|>|>|g; $message->{params}[1] =~ s|<|<|g; 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 $body =~ s|\s\n|/ |g; 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;