mojo-owncast-irc-bridge/myapp.pl

#!/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.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|>|&gt;|g;
		$message->{params}[1] =~ s|<|&lt;|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;