Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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; }

Hope that helps

perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'

In reply to Re^2: a lot of the CPAN big hitters have gone by cavac
in thread a lot of the CPAN big hitters have gone by tobyink

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others meditating upon the Monastery: (5)
    As of 2020-09-26 19:12 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      If at first I donít succeed, I Ö










      Results (142 votes). Check out past polls.

      Notices?