#!/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;
}
[download]