Websockets in Perl aren't that hard. I don't have time ATM to make a simple example, but here is my websocket client that "translates" between Net::Clacks and the OBS web/websocket server:
#!/usr/bin/env perl
#---AUTOPRAGMASTART---
use 5.020;
use strict;
use warnings;
use diagnostics;
use mro 'c3';
use English qw(-no_match_vars);
use Carp;
our $VERSION = 2.4;
use Fatal qw( close );
use Array::Contains;
#---AUTOPRAGMAEND---
use IO::Socket::IP;
use Data::Dumper;
use Protocol::WebSocket::Frame;
use Time::HiRes qw[sleep];
use JSON::XS;
use XML::Simple;
use Net::Clacks::Client;
use Crypt::Digest::SHA256 qw[sha256_b64];
use Encode qw[encode_utf8 decode_utf8 is_utf8];
my $clacksconfig = XMLin('dskyconfig.xml');
my $obsconfig = XMLin('obsconfig.xml');
my $sock;
while(1) {
$sock = IO::Socket::IP->new(
PeerHost => $obsconfig->{ip},
PeerPort => $obsconfig->{port},
Type => SOCK_STREAM,
Blocking => 1,
);
last if(defined($sock));
binmode($sock);
print "OBS not available...\n";
sleep(10);
}
$sock->blocking(0);
my $clacks;
if(defined($clacksconfig->{clackssocket}) && $clacksconfig->{clackshos
+t} ne '') {
$clacks = Net::Clacks::Client->newSocket($clacksconfig->{clackssoc
+ket}, $clacksconfig->{clacksuser}, $clacksconfig->{clackspassword}, '
+DSKY');
} else {
$clacks = Net::Clacks::Client->new($clacksconfig->{clackshost}, $c
+lacksconfig->{clacksport}, $clacksconfig->{clacksuser}, $clacksconfig
+->{clackspassword}, 'DSKY');
}
$clacks->set('OBS::Alive', 1);
$clacks->listen('OBS::SelectScene');
$clacks->listen('OBS::Streaming');
$clacks->listen('OBS::SelectVoice');
$clacks->doNetwork();
my $nextping = 0;
my $authmsgid = '';
my $lastobspacket = time;
my $sendobsversionrequest = 0;
my %scenes = (
1 => '1 ... Starting soon...',
2 => '2 ... shortbreak',
3 => '3 ... Streamending',
4 => '4 ... Desktop',
5 => '5 ... Technical Difficulties',
6 => '6 ... Camera',
);
my %voices = (
0 => 'Mike',
1 => 'VoiceDarth',
2 => 'VoiceMicki',
3 => 'VoiceComputer',
);
binmode $sock;
my $header =
"GET / HTTP/1.1\r\n" .
"Host: localhost\r\n" .
"Upgrade: websocket\r\n" .
"Connection: Upgrade\r\n" .
"Sec-WebSocket-Key: x3JJHMbDL1EzLkh9GBhXDw==\r\n" .
"Sec-WebSocket-Protocol: chat, superchat\r\n" .
"Sec-WebSocket-Version: 13\r\n" .
"Origin: https://cavac.at\r\n" .
"\r\n";
syswrite($sock, $header);
my $line = "";
while(1) {
my $char;
sysread($sock, $char, 1);
if(defined($char) && length($char)) {
if($char eq "\r") {
next;
} elsif($char eq "\n") {
if($line eq "") {my $pdf = PDF::Report->new(File => "templ
+ate_computer.pdf");
# end of header
last;
} else {
$line = "";
}
} else {
$line .= $char;
}
}
}
my $frame = Protocol::WebSocket::Frame->new(max_payload_size => 500 *
+1024 * 1024, masked => 1);
# Request authentication
if(1){
my %request = (
'request-type' => 'GetAuthRequired',
'message-id' => 'rand' . int(rand(1_000_000)),
);
my $outframe = $frame->new(buffer => encode_json(\%request), type
+=> 'text', masked => 1)->to_bytes;
syswrite($sock, $outframe);
}
if(0){
}
while(1) {
# Read from socket
while(1) {
my $char;
sysread($sock, $char, 1);
last if(!defined($char) || !length($char));
$frame->append($char);
}
while(my $data = $frame->next_bytes) {
my $msg = decode_json($data);
# Got any kind of OBS packet, so it's still alive. Reset our t
+imeout and notify display that we have OBS connection
$lastobspacket = time;
$sendobsversionrequest = 0;
$clacks->set('OBS::Alive', 1);
if(defined($msg->{'authRequired'})) {
# Start authentication
my $secret = sha256_b64($obsconfig->{password} . $msg->{sa
+lt});
$secret .= $msg->{challenge};
my $auth = sha256_b64($secret);
$authmsgid = 'auth_' . int(rand(1_000_000));
my %request = (
'request-type' => 'Authenticate',
'auth' => $auth,
'message-id' => $authmsgid,
);
my $outframe = $frame->new(buffer => encode_json(\%request
+), type => 'text', masked => 1)->to_bytes;
syswrite($sock, $outframe);
} elsif(defined($msg->{'message-id'}) && $msg->{'message-id'}
+=~ /^auth\_/ && $msg->{'message-id'} eq $authmsgid) {
# Auth reply
if(defined($msg->{status}) && $msg->{status} eq 'ok') {
# auth ok
print "Authenticated to OBS\n";
# Enable real heartbeat
my %request = (
'request-type' => 'SetHeartbeat',
'enable' => \1, # Boolean TRUE
'message-id' => 'heartbeat_' . int(rand(1_000_000)
+),
);
my $outframe = $frame->new(buffer => encode_json(\%req
+uest), type => 'text', masked => 1)->to_bytes;
syswrite($sock, $outframe);
} else {
# Auth failed!
print "AUTHENTICATION FAILED!!!!!\n";
sleep(30);
exit(1);
}
} elsif(defined($msg->{'message-id'}) && $msg->{'message-id'}
+=~ /^heartbeat\_/) {
if(defined($msg->{status}) && $msg->{status} eq 'ok') {
print "Heartbeat enabled\n";
} else {
print "Failed to enable heartbeat!\n";
}
} elsif(defined($msg->{'update-type'}) && $msg->{'update-type'
+} eq 'SwitchScenes') {
my $scene = substr $msg->{'scene-name'}, 0, 1;
print "Selected scene: ", $scene, "\n";
$clacks->set('OBS::SceneSelected', $scene);
} elsif(defined($msg->{'update-type'}) && $msg->{'update-type'
+} eq 'StreamStatus') {
if($msg->{'streaming'}) {
$clacks->set('OBS::StreamStatus', 1);
} else {
$clacks->set('OBS::StreamStatus', 0);
}
} elsif(defined($msg->{'update-type'}) && $msg->{'update-type'
+} eq 'TransitionBegin') {
print "Transitioning to new scene\n";
} elsif(defined($msg->{'update-type'}) && $msg->{'update-type'
+} eq 'Heartbeat') {
print "OBS Heartbeat\n";
} elsif(defined($msg->{'obs-studio-version'})) {
print "OBS Studio version: ", $msg->{'obs-studio-version'}
+, "\n";
print "OBS Websocket version: ", $msg->{'obs-websocket-ver
+sion'}, "\n";
} else {
print "Opcode: ", $frame->opcode, "\n";
print Dumper($msg);
}
}
$clacks->doNetwork();
# No data packet for more than 10 seconds, send a "OBS Version" re
+quest *once*
if(!$sendobsversionrequest && (time - $lastobspacket) > 10) {
print "No heartbeat from OBS, requesting livetick as a backup
+measure\n";
my %request = (
'request-type' => 'GetVersion',
'message-id' => 'rand' . int(rand(1_000_000)),
);
my $outframe = $frame->new(buffer => encode_json(\%request), t
+ype => 'text', masked => 1)->to_bytes;
syswrite($sock, $outframe);
$sendobsversionrequest = 1;
}
# No data packet for more than 20 seconds and we already send a ve
+rsion request!
# We are pretty sure that OBS is not available. So notify display,
+ and shut down program cleanly
# (will be externally restarted by bash script)
if($sendobsversionrequest && (time - $lastobspacket) > 20) {
print "Can't get info from OBS\n";
$clacks->set('OBS::Alive', 0);
for(1..10) {
$clacks->doNetwork();
sleep(0.1);
}
$clacks = undef;
exit(0);
}
$clacks->doNetwork();
while(my $msg = $clacks->getNext()) {
if($msg->{type} eq 'serverinfo') {
print "Connected to clacks server with version ", $msg->{d
+ata}, "\n";
next;
}
if($msg->{type} eq 'disconnect') {
# Disconnected from clacks, wait 10 seconds and then resta
+rt
print "Clacks disconnect\n";
sleep(10);
exit(0);
}
next unless($msg->{type} eq 'set');
if($msg->{name} eq 'OBS::SelectScene') {
if(!defined($scenes{$msg->{data}})) {
print "Invalid scene selected\n";
}
my %request = (
'request-type' => 'SetCurrentScene',
'scene-name' => $scenes{$msg->{data}},
'message-id' => 'rand' . int(rand(1_000_000)),
);
my $outframe = $frame->new(buffer => encode_json(\%request
+), type => 'text', masked => 1)->to_bytes;
syswrite($sock, $outframe);
} elsif($msg->{name} eq 'OBS::SelectVoice') {
my $selectedvoice = $msg->{data};
foreach my $voice (sort keys %voices) {
my %request = (
'request-type' => 'SetMute',
'message-id' => 'rand' . int(rand(1_000_000)),
'source' => $voices{$voice},
'mute' => \1,
);
if($voice eq $selectedvoice) {
$request{mute} = \0;
}
my $buffer = encode_json(\%request);
print "--\n", $buffer, "\n--\n";
my $outframe = $frame->new(buffer => encode_json(\%req
+uest), type => 'text', masked => 1)->to_bytes;
#syswrite($sock, $outframe);
}
} elsif($msg->{name} eq 'OBS::Streaming') {
my $type = 'StopStreaming';
if($msg->{data} == 1) {
$type = 'StartStreaming';
}
my %request = (
'request-type' => $type,
'message-id' => 'rand' . int(rand(1_000_000)),
);
my $outframe = $frame->new(buffer => encode_json(\%request
+), type => 'text', masked => 1)->to_bytes;
syswrite($sock, $outframe);
}
}
if($nextping < time) {
$clacks->ping();
$nextping = time + 30;
}
$clacks->doNetwork();
}
sub webPrint {
my ($connection, $data) = @_;
my @parts = split//, $data;
foreach my $part (@parts) {
if(ord($part) > 255) {
print "HIGH CHAR DETECTED!\n";
}
while(1) {
my $cnt;
eval {
$cnt = syswrite($connection, $part);
};
croak($@) if $@;
last if(defined($cnt) && $cnt == 1);
sleep(0.01);
}
}
return;
}