I sometimes stream on Youtube. Sometimes i play early access games that are rather allergic to tabbing out. So, controlling my streaming software, OBS, has always been a bit complicated. But what i DO have is my Apollo DSKY inspired home automation console next to my main keyboard, which is connected to rest rest of my house via Net::Clacks.
Implementing the GUI is a whole other story for another day. The DSKY project code is weird, even for my standards. This time, we are just looking into controlling some functionality of OBS via Net::Clacks.
Next, we'll write some config files.
Next step is to try to connect to the OBS websocket. If this doesn't work, we just sleep for a bit and try again. This way, the client can just run in the background all the time and we can start OBS when we need it.
Now that we have a connection to OBS, we have to set up Net::Clacks and pre-define which "scenes" we have in OBS:
my $clacks;
if(defined($clacksconfig->{clackssocket}) && $clacksconfig->{clackssoc
+ket} 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::Recording');
$clacks->listen('OBS::MuteVoice');
$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',
);
Before we can handle Websocket frames, we have to do the websocket-dance with the webserver to comply to RFC standards. We could do it the proper way using a proper client library. But screw it, we only need to request what is basically a static page to trigger the switch to websocket mode. Hardcoding the handshake is good enough for home use.
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 "") {
# end of header
last;
} else {
$line = "";
}
} else {
$line .= $char;
}
}
}
my $frame = Protocol::WebSocket::Frame->new(max_payload_size => 500 *
+1024 * 1024, masked => 1);
While practically all of the communication handling is in a state machine, we first need to send a once-off request for an authentication request.
# 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);
}
Let's start with the state machine by handling message from OBS to our program, specifically the authentication. We also enable the heartbeat. In case authentication fails, we'll just exit.
my $mutemessageid = '';
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";
}
Handling the heartbeat is easy enough. Just print out a debug message. The same goes for the server info.
} 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";
We also handle responses for some "real" requests, mostly by sending the parsed answer to the Net::Clacks network.
} 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 'RecordingStarted' ||
$msg->{'update-type'} eq 'RecordingResumed')) {
$clacks->set('OBS::RecordingStatus', 1);
} elsif(defined($msg->{'update-type'}) && ($msg->{'update-type
+'} eq 'RecordingStopped' ||
$msg->{'update-type'} eq 'RecordingPaused')) {
$clacks->set('OBS::RecordingStatus', 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 'SourceMuteStateChanged') {
# # We get the info that mute has changed, but not it's new
+status. Let's request it
my %request = (
'request-type' => 'GetMute',
'message-id' => 'rand' . int(rand(1_000_000)),
'source' => 'Mike',
);
$mutemessageid = $request{'message-id'};
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'}
+eq $mutemessageid) {
# Check if we got muted or not
my $ismuted = $msg->{muted};
$mutemessageid = '';
$clacks->set('OBS::MutedVoice', $ismuted);
print "Mike muted: ", $ismuted, "\n";
} else {
print "Opcode: ", $frame->opcode, "\n";
print "iscont ", $frame->is_continuation, "\n";
print Dumper($msg);
}
}
Call doNetwork() for Clacks before some time based OBS requests. I like to sprinkle doNetwork() throughout code that potentially does some slow stuff. This gives Clacks more changes to send and receive data through without clogging up the buffers on the sockets. Then we do some timeout based requests.
$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);
}
We basically to another if/elseif chain to handle message from Net::Clacks to OBS:
$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::MuteVoice') {
my $ismute = $msg->{data};
my %request = (
'request-type' => 'SetMute',
'message-id' => 'rand' . int(rand(1_000_000)),
'source' => 'Mike',
'mute' => \1,
);
if(!$ismute) {
$request{mute} = \0;
}
my $buffer = encode_json(\%request);
print "--\n", $buffer, "\n--\n";
my $outframe = $frame->new(buffer => encode_json(\%request
+), 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);
} elsif($msg->{name} eq 'OBS::Recording') {
my $type = 'StopRecording';
if($msg->{data} == 1) {
$type = 'StartRecording';
}
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();
}
And just for reference, here's the complete program for easier download:
#!/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));
print "OBS not available...\n";
sleep(10);
}
binmode($sock);
$sock->blocking(0);
my $clacks;
if(defined($clacksconfig->{clackssocket}) && $clacksconfig->{clackssoc
+ket} 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::Recording');
$clacks->listen('OBS::MuteVoice');
$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',
);
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 "") {
# 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){
}
my $mutemessageid = '';
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 'RecordingStarted' ||
$msg->{'update-type'} eq 'RecordingResumed')) {
$clacks->set('OBS::RecordingStatus', 1);
} elsif(defined($msg->{'update-type'}) && ($msg->{'update-type
+'} eq 'RecordingStopped' ||
$msg->{'update-type'} eq 'RecordingPaused')) {
$clacks->set('OBS::RecordingStatus', 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";
} elsif(defined($msg->{'update-type'}) && $msg->{'update-type'
+} eq 'SourceMuteStateChanged') {
# # We get the info that mute has changed, but not it's new
+status. Let's request it
my %request = (
'request-type' => 'GetMute',
'message-id' => 'rand' . int(rand(1_000_000)),
'source' => 'Mike',
);
$mutemessageid = $request{'message-id'};
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'}
+eq $mutemessageid) {
# Check if we got muted or not
my $ismuted = $msg->{muted};
$mutemessageid = '';
$clacks->set('OBS::MutedVoice', $ismuted);
print "Mike muted: ", $ismuted, "\n";
} else {
print "Opcode: ", $frame->opcode, "\n";
print "iscont ", $frame->is_continuation, "\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::MuteVoice') {
my $ismute = $msg->{data};
my %request = (
'request-type' => 'SetMute',
'message-id' => 'rand' . int(rand(1_000_000)),
'source' => 'Mike',
'mute' => \1,
);
if(!$ismute) {
$request{mute} = \0;
}
my $buffer = encode_json(\%request);
print "--\n", $buffer, "\n--\n";
my $outframe = $frame->new(buffer => encode_json(\%request
+), 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);
} elsif($msg->{name} eq 'OBS::Recording') {
my $type = 'StopRecording';
if($msg->{data} == 1) {
$type = 'StartRecording';
}
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();
}
